I am needing to write a query to add tabs for each unique value in column A (Employer) and the associated data with each row of data. Any help is appreciated!!
For example
I have this written, but am hitting an error:
Sub CreateSheets()
Application.ScreenUpdating = False
Dim rng As Range, RngList As Object, srcWS As Worksheet
Set srcWS = Sheets("Sheet1")
Set RngList = CreateObject("Scripting.Dictionary")
For Each rng In Range("A1", Range("A" & Rows.Count).End(xlUp))
If Not RngList.Exists(rng.Value) Then
RngList.Add rng.Value, Nothing
With srcWS.Cells(1).CurrentRegion
.AutoFilter 4, rng
If Not Evaluate("isref('" & rng.Value & "'!A1)") Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = rng
srcWS.AutoFilter.Range.Copy Cells(1, 1)
End If
End With
End If
Next rng
srcWS.Range("A1").AutoFilter
Application.ScreenUpdating = True
End Sub
For example
Employer | Name | Amount | Date | |
ABC tech | Joe Smith | 100 | 07/04/23 | |
X auto | Mary Johnson | 50 | 07/01/23 |
I have this written, but am hitting an error:
Sub CreateSheets()
Application.ScreenUpdating = False
Dim rng As Range, RngList As Object, srcWS As Worksheet
Set srcWS = Sheets("Sheet1")
Set RngList = CreateObject("Scripting.Dictionary")
For Each rng In Range("A1", Range("A" & Rows.Count).End(xlUp))
If Not RngList.Exists(rng.Value) Then
RngList.Add rng.Value, Nothing
With srcWS.Cells(1).CurrentRegion
.AutoFilter 4, rng
If Not Evaluate("isref('" & rng.Value & "'!A1)") Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = rng
srcWS.AutoFilter.Range.Copy Cells(1, 1)
End If
End With
End If
Next rng
srcWS.Range("A1").AutoFilter
Application.ScreenUpdating = True
End Sub