From f0503dd266f9f72aa6ed2a47de5fa69448e0746d Mon Sep 17 00:00:00 2001
From: kevinowino869 <kevinowino869@www.codelab.nestict.africa>
Date: Sun, 2 Mar 2025 14:24:11 +0100
Subject: [PATCH] Update FilterAndExtractData/FilterAndExtractData.bas

---
 FilterAndExtractData/FilterAndExtractData.bas | 95 +++++++++----------
 1 file changed, 47 insertions(+), 48 deletions(-)

diff --git a/FilterAndExtractData/FilterAndExtractData.bas b/FilterAndExtractData/FilterAndExtractData.bas
index 125cb55..30b7146 100644
--- a/FilterAndExtractData/FilterAndExtractData.bas
+++ b/FilterAndExtractData/FilterAndExtractData.bas
@@ -1,48 +1,47 @@
-Attribute VB_Name = "FilterAndExtractData"
-Sub FilterAndExtractData()
-    Dim wsData As Worksheet, wsDash As Worksheet
-    Dim lastRow As Long, headerRow As Long
-    Dim yearFilter As String, programFilter As String, countyFilter As String
-    Dim rng As Range, filterRange As Range, copyRange As Range
-    
-    ' Set references to sheets
-    Set wsData = ThisWorkbook.Sheets("Datasheet")
-    Set wsDash = ThisWorkbook.Sheets("Dashboard")
-
-    ' Define last row of data
-    lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
-    headerRow = 1 ' Assuming headers are in row 1
-
-    ' Get filter values from Dashboard
-    yearFilter = Trim(wsDash.Range("B7").Value)    ' Year filter
-    programFilter = Trim(wsDash.Range("C7").Value) ' Program filter
-    countyFilter = Trim(wsDash.Range("D7").Value)  ' County filter
-
-    ' Clear previous results
-    wsDash.Range("A10:L35").ClearContents
-
-    ' Set filter range
-    Set filterRange = wsData.Range(wsData.Cells(headerRow, 1), wsData.Cells(lastRow, wsData.UsedRange.Columns.Count))
-
-    ' Apply AutoFilter using the correct column numbers
-    filterRange.AutoFilter Field:=3, Criteria1:=programFilter ' Program (Column C = 3)
-    filterRange.AutoFilter Field:=4, Criteria1:=yearFilter ' Year (Column D = 4)
-    filterRange.AutoFilter Field:=6, Criteria1:=countyFilter ' County (Column F = 6)
-
-    ' Check if visible cells exist after filtering
-    On Error Resume Next
-    Set copyRange = filterRange.Offset(1, 0).Resize(filterRange.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
-    On Error GoTo 0
-
-    If Not copyRange Is Nothing Then
-        ' Copy headers
-        wsData.Rows(headerRow).Copy Destination:=wsDash.Rows(9) ' Paste headers at row 9
-        ' Copy filtered data
-        copyRange.Copy
-        wsDash.Cells(10, 1).PasteSpecial Paste:=xlPasteValues
-        wsDash.Cells(10, 1).PasteSpecial Paste:=xlPasteFormats
-        Application.CutCopyMode = False
-    Else
-        MsgBox "No records found for selected filters!", vbExclamation
-    End If
-End Sub
+Sub FilterAndExtractData()
+    Dim wsData As Worksheet, wsDash As Worksheet
+    Dim lastRow As Long, headerRow As Long
+    Dim yearFilter As String, programFilter As String, countyFilter As String
+    Dim rng As Range, filterRange As Range, copyRange As Range
+    
+    ' Set references to sheets
+    Set wsData = ThisWorkbook.Sheets("Datasheet")
+    Set wsDash = ThisWorkbook.Sheets("Dashboard")
+
+    ' Define last row of data
+    lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
+    headerRow = 1 ' Assuming headers are in row 1
+
+    ' Get filter values from Dashboard
+    yearFilter = Trim(wsDash.Range("B7").Value)    ' Year filter
+    programFilter = Trim(wsDash.Range("C7").Value) ' Program filter
+    countyFilter = Trim(wsDash.Range("D7").Value)  ' County filter
+
+    ' Clear previous results
+    wsDash.Range("A10:ZL100000").ClearContents
+
+    ' Set filter range
+    Set filterRange = wsData.Range(wsData.Cells(headerRow, 1), wsData.Cells(lastRow, wsData.UsedRange.Columns.Count))
+
+    ' Apply AutoFilter using the correct column numbers
+    filterRange.AutoFilter Field:=3, Criteria1:=programFilter ' Program (Column C = 3)
+    filterRange.AutoFilter Field:=4, Criteria1:=yearFilter ' Year (Column D = 4)
+    filterRange.AutoFilter Field:=6, Criteria1:=countyFilter ' County (Column F = 6)
+
+    ' Check if visible cells exist after filtering
+    On Error Resume Next
+    Set copyRange = filterRange.Offset(1, 0).Resize(filterRange.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
+    On Error GoTo 0
+
+    If Not copyRange Is Nothing Then
+        ' Copy headers
+        wsData.Rows(headerRow).Copy Destination:=wsDash.Rows(9) ' Paste headers at row 9
+        ' Copy filtered data
+        copyRange.Copy
+        wsDash.Cells(10, 1).PasteSpecial Paste:=xlPasteValues
+        wsDash.Cells(10, 1).PasteSpecial Paste:=xlPasteFormats
+        Application.CutCopyMode = False
+    Else
+        MsgBox "No records found for selected filters!", vbExclamation
+    End If
+End Sub