Auto Populate Cells Based on a Criteria

i have an excel sheet attached and I need to be able to auto populate the cells based on a criteria (Case Number) using VBA. I am able to do this using excel formula but it takes time to loaod the results so I thought it would be better to use VBA instead. Can somebody help me pls. thanks in advance

Hi danallamas

If I understood your requirement correctly then this solves:

Option Explicit

Sub CaseNoPop()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim CaseNumber As String, FindNumber As String, rng As Range, cell As Range
Dim lRow As Long, nRow As Long
Application.ScreenUpdating = False
Set ws1 = Sheets("Tracker")
Set ws2 = Sheets("DumpSheet")
lRow = ws2.Cells(Rows.Count, "F").End(xlUp).Row
CaseNumber = ws1.Range("C2")
Set rng = ws2.Range("F2:F" & lRow)
        For Each cell In rng
            FindNumber = cell.Value
            If FindNumber = CaseNumber Then
                With ws1
                    nRow = ws1.Cells(Rows.Count, "B").End(xlUp).Row + 1
                    .Cells(nRow, 1) = CaseNumber' I made provision for Case Number in Col A 
                    .Cells(nRow, 2) = cell.Offset(, -5).Value
                    .Cells(nRow, 3) = cell.Offset(, 2).Value
                    .Cells(nRow, 4) = cell.Offset(, 3).Value
                    .Cells(nRow, 5) = cell.Offset(, 4).Value
                    .Cells(nRow, 6) = cell.Offset(, 5).Value
                End With
            End If
        Next cell
Application.ScreenUpdating = True
End Sub

You may try something like this to make it more robust.

Right click on Tracker Sheet Tab --> View Code --> Place the following two codes into the opened code window.
The selection change event code will insert a drop down list of Case Numbers dynamically when you select the cell C2.
The change event code will trigger a macro that will fetch the relevant data from the DumpSheet as per the case number selected in C2.

Codes on Tracker Sheet Module:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim lr As Long
If Target.Address(0, 0) = "C2" Then
    If Target <> "" Then
        Application.EnableEvents = False
        Call GetRelevantData
        Application.EnableEvents = True
    Else
        Application.EnableEvents = False
        lr = Cells(Rows.Count, 2).End(xlUp).Row
        If lr > 5 Then Range("B6:F" & lr).Clear
        Application.EnableEvents = True
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim sws As Worksheet
Dim x, dict
Dim lr As Long, i As Long

If Target.Address(0, 0) = "C2" Then
    Set sws = Sheets("DumpSheet")
    lr = sws.Cells(Rows.Count, 6).End(xlUp).Row
    x = sws.Range("F2:F" & lr).Value
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(x, 1)
        dict.Item(x(i, 1)) = ""
    Next i
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                            xlBetween, Formula1:=Join(dict.keys, ",")
    End With
End If
End Sub

Code on Standard Module:
Now insert a New Module and place the following code into the new code window.

Sub GetRelevantData()
Dim dws As Worksheet, sws As Worksheet
Dim lr As Long
Application.ScreenUpdating = False
Set dws = Sheets("Tracker")
Set sws = Sheets("DumpSheet")
lr = dws.UsedRange.Rows.Count

If lr > 5 Then dws.Range("B6:F" & lr).Clear

sws.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                                            CriteriaRange:=dws.Range("C1:C2"), _
                                            CopyToRange:=dws.Range("B5:F5"), _
                                            Unique:=False


lr = dws.Cells(Rows.Count, 2).End(xlUp).Row
If lr > 5 Then
    dws.Range("B5").CurrentRegion.Borders.Color = vbBlack
End If

Application.ScreenUpdating = True
End Sub

For details, refer to the attached. To test the code, select a case number in C2 on tracker sheet.

If you are just wanting to filter DumpSheet then add a ComboBox to DumpSheet with the following code:
In a std module:

Option Explicit

Sub Auto_Open()
Dim cell As Range, rng As Range
Dim FirstCell As String, lRow As Long
lRow = Sheets("DumpSheet").Cells(Rows.Count, "F").End(xlUp).Row
Set rng = Sheets("DumpSheet").Range("F2:F" & lRow)
    FirstCell = rng.Cells(2, 6).Address
    For Each cell In rng
    
        If Evaluate("=COUNTIF(" & FirstCell & ":" & cell.Address(0, 0) & ", " & cell.Address & ")") = 1 Then
            Sheets("DumpSheet").ComboBox1.AddItem cell.Value
        End If
    Next cell
End Sub

ComboBox code

Option Explicit

Private Sub ComboBox1_Change()
Application.ScreenUpdating = False
Range("F2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=6, Criteria1:=ComboBox1.Value, Operator:=xlAnd
Application.ScreenUpdating = True
End Sub