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]

Do the following:
- Put the macro in your book
- You must have a sheet called "Template" where you will put the information
- In the template book you must create a sheet called "Temp"
- Change

"C:\trabajo\books\"

to your folder where the files will be saved

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("[COLOR=#ff0000]Template[/COLOR]")
    Set sh3 = wb1.Sheets("[COLOR=#ff0000]Temp[/COLOR]")
    
    location = "[COLOR=#ff0000]C:\trabajo\books\[/COLOR]"
    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:="[COLOR=#ff0000]V[/COLOR]"
    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 & " " & 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

Try and tell me.

 

[Ravin]

Dante you are a genius

Can I ask for some more help if you dont mind

Is it possible to change the name of the spitted out file to - ant = sh3.Cells(2, "F").Value & " - " & sh3.Cells(2, "G").Value and the date

I tried but it saved only the first file instance

Also would it be possible to rather than open a specific file manually

open the latest saved file in that location knowing it would always start "File A Week"

and then avoid step Set wSheet = .InputBox("Select a sheet and any cell from the open book.",

and have it do it automatically

and finally could all the files it spits out get saved into the location in a folder called dd-mm-yyyy

 

[DanteAmor]

Dante you are a genius

You're welcome and thanks for the feedback.

---

Is it possible to change the name of the spitted out file to - ant = sh3.Cells(2, "F").Value & " - " & sh3.Cells(2, "G").Value and the date

Change This:

[COLOR=#333333]wName = ant & " " & Format(Date, "yyyy-mm-dd")[/COLOR]

For this

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

---

Also would it be possible to rather than open a specific file manually
open the latest saved file in that location knowing it would always start "File A Week"
and then avoid step Set wSheet = .InputBox("Select a sheet and any cell from the open book.",
and have it do it automatically

This is your original request:

I then want to go to a specific tab and filter row 4 of that opened workbook

It's more complicated, since I do not know which sheet to get the data from, and in your requests it does not say which sheet. That's why you have to select the sheet.

---

and finally could all the files it spits out get saved into the location in a folder called dd-mm-yyyy

In the macro you can put the location.

 

[Ravin]

thanks Dante

The challenge are the users that I am getting to run the macro are not excel proficient, so as easy as this is they are still struggling so trying to eliminate user interaction to the bear minimum

When I change the code to wName = sh3.Cells(2, "F").Value & " - " & sh3.Cells(2, "G").Value & " " & Format(Date, "yyyy-mm-dd")

I only get one file in folder, do i need to change it in more than one place in the code

The file that is opened will always be named "file A" and date modified 27/03/2019

So ideally I want it to open the latest date modified excel document in that location automatically

The Tab of that workbook would always be called "Classification"

and what I meant is that I end up with multiple files such as

10125 - File A
10126 - File B
10126 - File C

in the right location

but is it possible to have all those files

but in a folder in the location called 27/03/2019

R

 

[DanteAmor]

Change This:
Code:
wName = ant & " " & Format(Date, "yyyy-mm-dd")
For this
Code:
wName = ant & " " & sh3.Cells(2, "F").Value & " - " & sh3.Cells(2, "G").Value & " " & Format(Date, "yyyy-mm-dd")

 

[Ravin]

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

it did this

12345 - 12345 - File A - 2019 03 28
47856 - 12345 - File A - 2019 03 28
78945 - 12345 - File A - 2019 03 28
65895 - 12345 - File A - 2019 03 28

this was the full code

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 = ant & " " & 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

 

[DanteAmor]

12345 - 12345 - File A - 2019 03 28
47856 - 12345 - File A - 2019 03 28
78945 - 12345 - File A - 2019 03 28
65895 - 12345 - File A - 2019 03 28

Is that correct?

The number 12345 comes from the cell F2

 

[Ravin]

Yes Cell F2 of temp

Whats happening is the F2 is repeating each row3 the first column is correct

I was expecting something like

11111 - File A - 29/03/2019
22222 - File B - 29/03/2019

what I am getting is

11111 - 11111 - File A - 29/03/2019
22222 - 11111 - File A - 29/03/2019

R

 

[DanteAmor]

I do not understand what do you need