Update ReportPerCounty/ReportPerCounty.bas

ReportPerCounty/ReportPerCounty.bas

@@ -1,94 +1,93 @@
-Attribute VB_Name = "ReportPerCounty"
-Sub GenerateCountyReports()
-    Dim ws As Worksheet, wsNew As Worksheet
-    Dim lastRow As Long, countyCol As Long, headerRow As Long
-    Dim cell As Range, county As Variant
-    Dim dict As Object
-    Dim rng As Range
-    
-    ' Set worksheet and find last row
-    Set ws = ThisWorkbook.Sheets("Datasheet")
-    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
-    headerRow = 1 ' Header row
-    
-    ' ?? Dynamically find "County of Residence" column
-    countyCol = 0
-    For Each cell In ws.Rows(headerRow).Cells
-        If Trim(LCase(cell.Value)) = "county of residence" Then
-            countyCol = cell.Column
-            Exit For
-        End If
-    Next cell
-    
-    ' ?? Check if "County of Residence" column was found
-    If countyCol = 0 Then
-        MsgBox "Error: 'County of Residence' column not found!", vbCritical
-        Exit Sub
-    End If
-    
-    ' Create dictionary to store county names
-    Set dict = CreateObject("Scripting.Dictionary")
-    
-    ' Loop through county column to find unique counties
-    For Each cell In ws.Range(ws.Cells(headerRow + 1, countyCol), ws.Cells(lastRow, countyCol))
-        county = Trim(cell.Value)
-        If county <> "" And Not dict.exists(county) Then
-            dict.Add county, Nothing
-        End If
-    Next cell
-    
-    ' Turn off screen updating for better performance
-    Application.ScreenUpdating = False
-    
-    ' Create sheets for each county and copy relevant data
-    For Each county In dict.keys
-        ' Check if sheet exists
-        On Error Resume Next
-        Set wsNew = ThisWorkbook.Sheets(county)
-        On Error GoTo 0
-        
-        ' If sheet doesn't exist, create it
-        If wsNew Is Nothing Then
-            Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
-            wsNew.Name = county
-        End If
-        
-        ' Clear previous content
-        wsNew.Cells.Clear
-        
-        ' Copy headers
-        ws.Rows(headerRow).Copy Destination:=wsNew.Rows(headerRow)
-        
-        ' Filter and copy data
-        ws.Range(ws.Cells(headerRow, 1), ws.Cells(lastRow, ws.UsedRange.Columns.Count)).AutoFilter Field:=countyCol, Criteria1:=county
-        Set rng = ws.Range(ws.Cells(headerRow + 1, 1), ws.Cells(lastRow, ws.UsedRange.Columns.Count)).SpecialCells(xlCellTypeVisible)
-        
-        If Not rng Is Nothing Then
-            rng.Copy
-            wsNew.Cells(2, 1).PasteSpecial Paste:=xlPasteValues
-            wsNew.Cells(2, 1).PasteSpecial Paste:=xlPasteFormats
-            Application.CutCopyMode = False
-        End If
-        
-        ' Turn off AutoFilter
-        ws.AutoFilterMode = False
-        
-        ' Adjust column width
-        wsNew.Cells.EntireColumn.AutoFit
-        
-        ' Remove sheet if no data copied
-        If wsNew.UsedRange.Rows.Count = 1 Then
-            Application.DisplayAlerts = False
-            wsNew.Delete
-            Application.DisplayAlerts = True
-        End If
-        
-        Set wsNew = Nothing
-    Next county
-    
-    ' Turn on screen updating
-    Application.ScreenUpdating = True
-    
-    MsgBox "County reports generated successfully!", vbInformation
-End Sub
-
+Sub GenerateCountyReports()
+    Dim ws As Worksheet, wsNew As Worksheet
+    Dim lastRow As Long, countyCol As Long, headerRow As Long
+    Dim cell As Range, county As Variant
+    Dim dict As Object
+    Dim rng As Range
+    
+    ' Set worksheet and find last row
+    Set ws = ThisWorkbook.Sheets("Datasheet")
+    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
+    headerRow = 1 ' Header row
+    
+    ' ?? Dynamically find "County of Residence" column
+    countyCol = 0
+    For Each cell In ws.Rows(headerRow).Cells
+        If Trim(LCase(cell.Value)) = "county of residence" Then
+            countyCol = cell.Column
+            Exit For
+        End If
+    Next cell
+    
+    ' ?? Check if "County of Residence" column was found
+    If countyCol = 0 Then
+        MsgBox "Error: 'County of Residence' column not found!", vbCritical
+        Exit Sub
+    End If
+    
+    ' Create dictionary to store county names
+    Set dict = CreateObject("Scripting.Dictionary")
+    
+    ' Loop through county column to find unique counties
+    For Each cell In ws.Range(ws.Cells(headerRow + 1, countyCol), ws.Cells(lastRow, countyCol))
+        county = Trim(cell.Value)
+        If county <> "" And Not dict.exists(county) Then
+            dict.Add county, Nothing
+        End If
+    Next cell
+    
+    ' Turn off screen updating for better performance
+    Application.ScreenUpdating = False
+    
+    ' Create sheets for each county and copy relevant data
+    For Each county In dict.keys
+        ' Check if sheet exists
+        On Error Resume Next
+        Set wsNew = ThisWorkbook.Sheets(county)
+        On Error GoTo 0
+        
+        ' If sheet doesn't exist, create it
+        If wsNew Is Nothing Then
+            Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
+            wsNew.Name = county
+        End If
+        
+        ' Clear previous content
+        wsNew.Cells.Clear
+        
+        ' Copy headers
+        ws.Rows(headerRow).Copy Destination:=wsNew.Rows(headerRow)
+        
+        ' Filter and copy data
+        ws.Range(ws.Cells(headerRow, 1), ws.Cells(lastRow, ws.UsedRange.Columns.Count)).AutoFilter Field:=countyCol, Criteria1:=county
+        Set rng = ws.Range(ws.Cells(headerRow + 1, 1), ws.Cells(lastRow, ws.UsedRange.Columns.Count)).SpecialCells(xlCellTypeVisible)
+        
+        If Not rng Is Nothing Then
+            rng.Copy
+            wsNew.Cells(2, 1).PasteSpecial Paste:=xlPasteValues
+            wsNew.Cells(2, 1).PasteSpecial Paste:=xlPasteFormats
+            Application.CutCopyMode = False
+        End If
+        
+        ' Turn off AutoFilter
+        ws.AutoFilterMode = False
+        
+        ' Adjust column width
+        wsNew.Cells.EntireColumn.AutoFit
+        
+        ' Remove sheet if no data copied
+        If wsNew.UsedRange.Rows.Count = 1 Then
+            Application.DisplayAlerts = False
+            wsNew.Delete
+            Application.DisplayAlerts = True
+        End If
+        
+        Set wsNew = Nothing
+    Next county
+    
+    ' Turn on screen updating
+    Application.ScreenUpdating = True
+    
+    MsgBox "County reports generated successfully!", vbInformation
+End Sub
+