Upload files to "FilterAndExtractData"

FilterAndExtractData/FilterAndExtractData.bas

@@ -0,0 +1,48 @@
+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