A total beginner looking for some help with this - I need my code to filter through a specific column that is common across all 6 sheets, but may not be the same column number across all sheets. Hence the code will need some kind of unique identifier, probably the unique column name. I then need the autofilter to run through that column and copy the output for the 6 unique variables (which are also common across the 6 sheets I have in the original workbook), then save the output with the same sheet names as what they are named in the original wb into new workbooks. New workbooks to be named with the 6 unique variables in the autofilter column. My code now produces 6 new workbooks, saved as the 6 unique variables - which is great. But it is only doing this action for the 1st sheet and I need the same to be done for all 6 sheets in the original workbook, so that with each new workbook, I have my 6 other sheets populated with the filtered data. Hope this makes sense and would appreciate some support from someone who is better than this than I am! Sharing my code below:
Option Explicit
Dim wsActiveListing As Worksheet
Dim LastRow As Long
Dim collection_UniqueList As Collection
'unique list is for automation to be applied to any column
Public Const Output_Folder_Path As String = "C:\Users\NoelleB\Desktop\Report112"
Sub MainProgram()
Dim instance As Long
Dim wb As Workbook
Set wsActiveListing = ThisWorkbook.Worksheets("Active Listing")
With wsActiveListing
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'using column A to figure out the last row number
If 2 > LastRow Then Exit Sub
Set collection_UniqueList = New Collection
Call UniqueList(collection_UniqueList)
For instance = 1 To collection_UniqueList.Count
.AutoFilterMode = False
.Range("A1:Z" & LastRow).AutoFilter .Range("G7").Column, collection_UniqueList.Item(instance)
.Range("A1").CurrentRegion.Copy
Set wb = Workbooks.Add
wb.Worksheets(1).Paste
wb.SaveAs Filename:=Output_Folder_Path & "_" & collection_UniqueList.Item(instance) & ".xlsx"
wb.Close False
Set wb = Nothing
.AutoFilterMode = False
Next instance
End With
MsgBox "Macro complete.", vbInformation
Set collection_UniqueList = Nothing
Set wsActiveListing = Nothing
End Sub
Private Sub UniqueList(ByRef col As Collection)
Dim RowNumber As Long
With wsActiveListing
On Error Resume Next
For RowNumber = 2 To LastRow
collection_UniqueList.Add .Cells(RowNumber, "G").Value, CStr(.Cells(RowNumber, "G").Value)
Next RowNumber
End With
End Sub