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

 

[Ravin]

ok so I would like the files to be spit out as so

11111 - Filename - 29/03/2019
22222 - new filename - 29/03/2019

the 11111 comes from F2
the filename comes from g2

once all the files have been created and are in location

I would like these collated in a folder called 29/03/2019

R

 

[Ravin]

Hi Dante

Sorry not sure if my reply is going through

I was expecting

11111 - ggggg - date
22222 - hhhhh - date

the 11111 comes from F2
the ggggg comes from G2
and the date is todays date

and then once all the files have been separeted and put in the location

I would like them all collated in a folder with todays date

R

 

[DanteAmor]

Are you talking about the file name?

 

[Ravin]

Hi Dante

So the macro works

I open the macro template
Run the code
it prompts me to open the main excel file
then click on the relevant tab of that main excel file
copies that tab from the opened workbook into temp tab of the macro

then the macro starts to run

and it begins creating separate excel files as expected

the files are named

00684 2019-04-03
00845 2019-04-03
00884 2019-04-03

the first 5 digit number is coming from column F2 in the temp tab

what I was hoping was that each new file could be named
slightly diffrently

00684 Red 2019-04-03

00684 comes from F2
Red comes from G2

Thats the first change I needed the slight rename of the file outputs

and the second change was that all the files are collated in a windows folder with the date

R

 

[DanteAmor]

In this line of code you have the value of F, the value of F2, the value of G2 and the date. What do you need?

[COLOR=#333333]wName = [/COLOR][COLOR=#006400]ant [/COLOR][COLOR=#333333]& " " & [/COLOR][COLOR=#0000ff]sh3.Cells(2, "F").Value [/COLOR][COLOR=#333333]& " - " & [/COLOR][COLOR=#ff0000]sh3.Cells(2, "G").Value[/COLOR][COLOR=#333333] & " " & Format(Date, [/COLOR][COLOR=#800000]"yyyy-mm-dd"[/COLOR][COLOR=#333333])[/COLOR]

 

[Ravin]

yes I understand that's what the code should do, but it doesn't

the filenames end up looking like this


AAAAA AAAAA Red 2019 04 04
BBBBB AAAAA Red 2019 04 04
CCCCC AAAAA Red 2019 04 04

So in first part of file name I get the value of F2

then it repeats
then it gets the value from G2
then applies same date

but then it copies down the same G2 value across all the filenames

it should have been

AAAAA Red 2019 04 04
BBBBB Blue 2019 04 04
CCCCC Green 2019 04 04

R

 

[DanteAmor]

Change this

wName = ant & " " & sh3.Cells(2, "F").Value & " - " & sh3.Cells(2, "G").Value & " " & Format(Date, "yyyy-mm-dd")

By:

wName = sh3.Cells(2, "F").Value & " - " & sh3.Cells(2, "G").Value & " " & Format(Date, "yyyy-mm-dd")

 

[Ravin]

thanks Dante

I tried the same code, but when it executes it only spits out 1 file

whereas if I leave the code as wName = ant & " " & Format(Date, "yyyy-mm-dd")

I get 70 files

70 files is the correct number

is it possible I need to adjust the code elsewhere

Sub Spits_workbooks()
Dim wb1 As Workbook, wb2 As Workbook, wb4 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
Dim wSheet As Variant, wTab As String, ant As String
Dim lr1 As Double, lr2 As Double, lr3 As Double, i As Long, j As Long
Dim location As String, wName As String

Application.DisplayAlerts = False

Set wb1 = ThisWorkbook
Set sh1 = wb1.Sheets("Template")
Set sh3 = wb1.Sheets("Temp")

location = "\\tpplc\store\WixHRW\Supply Chain\Central Supply Chain\Ranging and Multichannel\Dropship\Supplier Blank Stock Templates"
If Right(location, 1) <> "" Then location = location & ""

sh3.Cells.Clear

With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Pick a excel file"
.Filters.Add "Excel Files", "*.xls*"
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path & ""
If Not .Show Then Exit Sub
Set wb2 = Workbooks.Open(.SelectedItems.Item(1))
End With
On Error Resume Next
With Application
Set wSheet = .InputBox("Select a sheet and any cell from the open book.", "TAB", Default:=Selection.Address, Type:=8)
If wSheet Is Nothing Then Exit Sub
End With
On Error GoTo 0

Application.ScreenUpdating = False

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 = sh3.Cells(2, "F").Value & " - " & sh3.Cells(2, "G").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

R

 

[DanteAmor]

Aaaaaahhhh

Must be:

wName = ant & " - " & sh3.Cells(2, "G").Value & " " & Format(Date, "yyyy-mm-dd")

 

[Ravin]

Almost but now I have

AAAAA Red 2019 04 04
BBBBB Red 2019 04 04
CCCCC Red 2019 04 04

it copies the same value from G for each row

R