I am getting a subscript out of range error on my VBA below (Set wsRawData = ThisWorkbook.Worksheets("Raw Data")) and can't figure out how to fix it. My worksheet is named Raw Data. Would anyone be able to advise on how to fix this? Thanks!
Option Explicit
Dim wsRawData As Worksheet
Dim LastRow As Long
Dim collection_UniqueList As Collection
Public Const Output_Folder_Path As String = "<Output directory>"
Sub MainProgram()
Dim instance As Long
Dim wb As Workbook
Set wsRawData = ThisWorkbook.Worksheets("Raw Data")
With wsRawData
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
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:AN" & LastRow).AutoFilter .Range("AN1").Column, collection_UniqueList.Item(instance)
.Range("A1").CurrentRegion.Copy
Set wb = Workbooks.Add
wb.Worksheets(1).Paste
wb.SaveAs Filename:=Output_Folder_Path & "_" & Replace(Replace(collection_UniqueList.Item(instance), "/", ""), Chr(34), "") & ".xlsx"
wb.Close False
Set wb = Nothing
.AutoFilterMode = False
Next instance
End With
MsgBox "Macro complete.", vbInformation
Set collection_UniqueList = Nothing
Set wsRawData = Nothing
End Sub
Private Sub UniqueList(ByRef col As Collection)
Dim RowNumber As Long
With wsRawData
On Error Resume Next
For RowNumber = 2 To LastRow
collection_UniqueList.Add .Cells(RowNumber, "AN").Value, CStr(.Cells(RowNumber, "AN").Value)
Next RowNumber
End With
End Sub
Option Explicit
Dim wsRawData As Worksheet
Dim LastRow As Long
Dim collection_UniqueList As Collection
Public Const Output_Folder_Path As String = "<Output directory>"
Sub MainProgram()
Dim instance As Long
Dim wb As Workbook
Set wsRawData = ThisWorkbook.Worksheets("Raw Data")
With wsRawData
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
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:AN" & LastRow).AutoFilter .Range("AN1").Column, collection_UniqueList.Item(instance)
.Range("A1").CurrentRegion.Copy
Set wb = Workbooks.Add
wb.Worksheets(1).Paste
wb.SaveAs Filename:=Output_Folder_Path & "_" & Replace(Replace(collection_UniqueList.Item(instance), "/", ""), Chr(34), "") & ".xlsx"
wb.Close False
Set wb = Nothing
.AutoFilterMode = False
Next instance
End With
MsgBox "Macro complete.", vbInformation
Set collection_UniqueList = Nothing
Set wsRawData = Nothing
End Sub
Private Sub UniqueList(ByRef col As Collection)
Dim RowNumber As Long
With wsRawData
On Error Resume Next
For RowNumber = 2 To LastRow
collection_UniqueList.Add .Cells(RowNumber, "AN").Value, CStr(.Cells(RowNumber, "AN").Value)
Next RowNumber
End With
End Sub