Excel VBA code to filter two columns and extract data

Question

this is my first post and I am super excited about it. I apologize in advance if my writing wouldn't make sense since I'm not super familiar with coding/programming terms.

Here is the Micro_Enabled_Excel_File which I'm using.

I have an excel file with multiple columns and rows. The number of rows will increase as time passes. I'm trying to filter two columns and copy the latest/most recent datapoint(row) and paste it in a new sheet to create a status report.

Excel Dataset: image

What the results would look like: image

What I have done so far:

1. Created a Micro to go through columns "SCOPE" and "TRADE NAME" to grab the unique entries and copy it into another sheet called "Code".

Sub First_COPY_STYLE_TO_REPORT()

    'creating the Report sheet
    Sheets("Report").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Sheets("Status Updates").Select
    Cells.Select
    Selection.Copy
    Sheets("Report").Select
    ActiveSheet.Paste
    Rows("2:1048576").Select
    Application.CutCopyMode = False
    Selection.ClearContents

End Sub

2. Created a Micro to create a template for sheet "Report" which will eventually be filled with the results of next Micro.

Sub Second_COPY_UNIQUE_TO_CODE()

'add title to filter columns in the Code sheet
    Sheets("Code").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Filter1"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Filter2"

'creating the filter criteria also known as scope and trade name

    'Finds Duplicates on SCOPE column and copies it to a new sheet called CODE
    Sheets("Status Updates").Select
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Status Updates")
    Set s2 = Sheets("Code")
    s1.Range(Range("B2"), Range("B2").End(xlDown)).Copy s2.Range("A2")
    s2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo

    'Finds Duplicates on NAME column and copies it to a new sheet called CODE
    Dim s3 As Worksheet, s4 As Worksheet
    Set s3 = Sheets("Status Updates")
    Set s4 = Sheets("Code")
    s1.Range(Range("C2"), Range("C2").End(xlDown)).Copy s2.Range("B2")
    s4.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo

    'Clears formating and autofits column widths
    Sheets("Code").Cells.ClearFormats
    ThisWorkbook.Worksheets("Code").Cells.EntireColumn.AutoFit

End Sub

3. Created a Micro (Not Functioning) which includes two loops to filter two columns, sort the first column and copy and paste the second row of the sheet into the sheet "Report".

Sub Third_Generate_Latest_Status_Report()

    Dim a1 As Long, a2 As Long, b1 As Long, b2 As Long
        a1 = Cells.Find("Filter1").Offset(1, 0).Row
        a2 = Cells.Find("Filter1").End(xlDown).Row
        b1 = Cells.Find("Filter2").Offset(1, 0).Row
        b2 = Cells.Find("Filter2").End(xlDown).Row

    Dim g As Long, i As Long

    For g = a1 To a2 'Look up for Filter1 column. Then loop through all criterias.
        ActiveSheet.Range("$C$1:$J$300").AutoFilter Field:=2, Criteria1:=g
        For i = b1 To b2 'Look up for Filter2 column. Then loop through all criterias.
            ActiveSheet.Range("$C$1:$J$300").AutoFilter Field:=3, Criteria1:=i

            'sort the NO column from largest to smallest (to get the latest/most recent update).
            'I have copied this part of the code from the Micro I recorded.
            ActiveWorkbook.Worksheets("Status Updates").AutoFilter.Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Status Updates").AutoFilter.Sort.SortFields.Add2 _
                Key:=Range("C1:C300"), SortOn:=xlSortOnValues, Order:=xlDescending, _
                DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("Status Updates").AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
                'I think I need to add code here to copy the row to sheet Report, and run the loop again
            End With
        Next i 'take next value in column Filter2
    Next g 'take next value in column Filter1
End Sub

What I believe I need:

1. Sheet "Status Updates" - Filter "SCOPE" column and run through all criteria.Then,
2. Sheet "Status Updates" - Filter "TRADE NAME" column and run through all criteria.
3. Sort the "NO" column to get the most recent datapoint.
4. Copy the first row of data (meaning, the first row after the titles)
5. Paste it in another sheet called "Report".

Could you please take a look at my code and let me know what my mistakes are?

This is my first time coding/programming/using VBA.

Answer 1

Having an extra "code" sheet usually just makes things unnecessarily complicated. And because your "Status Updates" sheet is already sorted with Oldest updates to Newest updates, we know that for any given unique combo, you'll always want the bottom update. We can guarantee pulling that if we loop over your data backwards (from bottom row to first row, that's what the Step -1 does).

Then use a dictionary to check for unique combinations and pull the first encountered row (remember we're going backwards, so the first encountered row will be the latest update) for each unique combo and copy those rows over to your report sheet.

In the end, here's a fairly beginner friendly version of code for this task. I've commented it heavily for clarity so that you can follow along and understand what it does.

Sub tgr()

    'Declare and set workbook and worksheet object variables
    Dim wb As Workbook:         Set wb = ActiveWorkbook
    Dim wsUpdt As Worksheet:    Set wsUpdt = wb.Worksheets("Status updates")
    Dim wsRprt As Worksheet:    Set wsRprt = wb.Worksheets("Report")

    'Declare and set a range variable that contains your data
    Dim rUpdateData As Range:   Set rUpdateData = wsUpdt.Range("A2:G" & wsUpdt.Cells(wsUpdt.Rows.Count, "A").End(xlUp).Row)

    'Verify data actually exists
    If rUpdateData.Row < 2 Then Exit Sub    'If the beginning row is the header row, then no data actually exists

    'Use a dictionary object to keep track of unique Scope and Trade Name combos
    Dim hUnqScopeTrades As Object:  Set hUnqScopeTrades = CreateObject("Scripting.Dictionary")

    'Declare your resulting Copy Range variable. This will be used to gather only the range of rows that will be copied over to the Report worksheet
    Dim rCopy As Range

    'Declare a looping variable
    Dim i As Long

    'Loop through each row in your Status Updates data.  Because your updates are already sorted Oldest to Newest, begin at the end and loop backwards to guarantee newest updates are found first
    For i = rUpdateData.Rows.Count To 1 Step -1
        'Verify this Scope/Trade combo hasn't been seen before
        If Not hUnqScopeTrades.Exists(rUpdateData.Cells(i, 2).Value & "|" & rUpdateData.Cells(i, 3).Value) Then
            'This is a newly encountered unique combo
            'Add the combo to the dictionary
            hUnqScopeTrades(rUpdateData.Cells(i, 2).Value & "|" & rUpdateData.Cells(i, 3).Value) = i

            'If this is the first unique combo found, rCopy will be empty, check if that's the case
            If rCopy Is Nothing Then
                'rCopy is empty, add the first found unique combo to it
                Set rCopy = rUpdateData.Cells(i, 1)
            Else
                'rCopy is not empty, add all additional unique combos with the Union method
                Set rCopy = Union(rCopy, rUpdateData.Cells(i, 1))
            End If
        End If
    Next i

    'Clear previous results (if any)
    wsRprt.Range("A1").CurrentRegion.Offset(1).Clear

    'Verify rCopy isn't empty and then copy all rows over
    If Not rCopy Is Nothing Then rCopy.EntireRow.Copy wsRprt.Range("A2")

End Sub