Macro That Opens Another Workbook, Filters Results and Spits into Separate Workbooks

[Ravin]

Hello all, I need some help

I am trying to create a macro that opens a specific workbook in a specific location, or allows me to choose the workbook I am opening

I then want to go to a specific tab and filter row 4 of that opened workbook
I then want to filter column U for the value "V" of that opened workbook

from the presented results

I will have multiple records per ID in column F (The values in F will be a 5 digit number)

ID, Name, Age, Transport
01486 - Peter, 12, Red, Car
01486 - Fred, 0, Orange, Bike
56613 - Rob, 10, Yellow, Boat

I want to paste the values for each id in column F into my macro template

any values in column G into A11 onwards of my template for that ID
any values in column F into B11 onwards of my template for that ID
any values in column A into C11 onwards of my template for that ID
any values in column B into D11 onwards of my template for that ID

then from my macro template

for each ID I want to create a separate non macro workbook, but with headers etc, named as that ID and date i.e 01486_2019-03-22 in a specific location

is this possible, because I am really struggling

R

 

[DanteAmor]

Hi Dante

When I run original macro it runs correctly creates 71 files, and then completes with a message box that says end. So that works OK.

When I amend code to wName = ant & " " & sh4.Range("A11").Value & " " & Format(Date, "yyyy-mm-dd")

it stops at 21 files with a run time error, but it does name them correctly

R

What does the error message say and in what line does it stop?

 

[DanteAmor]

What does the error message say and in what line does it stop?

Also check what data you have in the cell sh4.Range("A11").Value of the file in process, maybe it have a character that is not allowed in the file name.

 

[Ravin]

it just says 400 with a red X

 

[Ravin]

yes I think your right it has a Swift Marketing Solutions T/A OHPOPSI

the forward slash may be the issue, is there a way I can exclude this value

 

[DanteAmor]

yes I think your right it has a Swift Marketing Solutions T/A OHPOPSI

the forward slash may be the issue, is there a way I can exclude this value

try this:

[COLOR=#333333]wName = ant & " " & [/COLOR][COLOR=#0000ff]Replace(sh4.Range("A11").Value, "/", "-")[/COLOR][COLOR=#333333] & " " & Format(Date, "yyyy-mm-dd")[/COLOR]

 

[Ravin]

Dante - perfect that did the trick it works

thankyou so much for your help.

Can I be a pain and ask for one more bit of help

if I wanted to put all of the separated files into a dated folder is that something I could also do in VBA

R

 

[DanteAmor]

Dante - perfect that did the trick it works

thankyou so much for your help.

Can I be a pain and ask for one more bit of help

if I wanted to put all of the separated files into a dated folder is that something I could also do in VBA

R

You have this

location = "\\tpplc\store\WixHRW\Supply Chain\Central Supply Chain\Ranging and Multichannel\Dropship\Supplier Blank Stock Templates"

Just add the date, something like that:

location = "\\tpplc\store\WixHRW\Supply Chain\Central Supply Chain\Ranging and Multichannel\" & _
           "Dropship\Supplier Blank Stock Templates\" & Format(Date, "mm-dd-yyyy")

But first you must create the folder

 

[Ravin]

Hi Dante

Me again I am trying to add another filter to the code and am clearly doing something wrong

wTab = wSheet.Worksheet.Name
Set sh2 = wb2.Sheets(wTab)
If sh2.AutoFilterMode Then sh2.AutoFilterMode = False
lr2 = sh2.Range("U" & Rows.Count).End(xlUp).Row
sh2.Range("A4:U" & lr2).AutoFilter Field:=21, Criteria1:="V"
sh2.Range("A4:U" & lr2).Copy sh3.Range("A1")

sh3.Range("A1").CurrentRegion.Sort key1:=sh3.Range("F1"), order1:=xlAscending, Header:=xlYes
ant = sh3.Cells(2, "F").Value
lr3 = sh3.Range("U" & Rows.Count).End(xlUp).Row

sh1.Copy
Set wb4 = ActiveWorkbook
Set sh4 = wb4.Sheets(1)
j = 11

For i = 2 To lr3 + 1
If ant <> sh3.Cells(i, "F").Value Then
wName = ant & " " & Replace(sh4.Range("A11").Value, "/", "-") & " " & Format(Date, "yyyy-mm-dd")
wb4.SaveAs location & wName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
wb4.Close False

If sh3.Cells(i, "F").Value = "" Then Exit For
sh1.Copy
Set wb4 = ActiveWorkbook
Set sh4 = wb4.Sheets(1)
j = 11
End If
sh4.Cells(j, "A").Value = sh3.Cells(i, "G").Value
sh4.Cells(j, "B").Value = sh3.Cells(i, "F").Value
sh4.Cells(j, "C").Value = sh3.Cells(i, "A").Value
sh4.Cells(j, "D").Value = sh3.Cells(i, "B").Value
j = j + 1
ant = sh3.Cells(i, "F").Value
Next
wb2.Close False
Application.ScreenUpdating = True




MsgBox "End"
End Sub

It filters column U for the value "V" correctly
I want it to also filter column AA for "On Website"

So I tried creating lr4

lr4 = sh2.Range("AA" & Rows.Count).End(xlUp).Row
sh2.Range("A4:AA" & lr4).AutoFilter Field:=27, Criteria1:="On Website"

but the code creates an error do I need to add this somewhere else in the code