H BG
H BG

Reputation: 81

vba error when using IndexMatch and two Criteria with Pivot Table

I am looking for a code to use an index match formula with 2 criteria. Index data is on sheet "cpk_mola_pivot" in pivot table called "cpk_mola_pivottable".
Results to be returned are in the pivot table column 3.
Criteria 1 is on source sheet "comparison report" in Column J starting row 3 to last row. Criteria 1 is matched to Column A in the pivot table. Criteria 2 is fixed in cell $O$2.
Criteria 2 is matched to Column B in the pivot table. Results to be populated O3 to last row in the source sheet "comparison report".

When I run the code I am getting an object required at the resultsrange code line even though I specified the pivottable.

sub cpkMola_indexmatch2

    Dim wsComparisonReport As Worksheet
    Dim wsCPK_Mola_Pivot As Worksheet
    Dim mypivotTable As pivotTable
    Dim lastRowComparison As Long, lastRowPivot As Long
    Dim criteria1 As Range, criteria2 As Variant
    Dim resultRange As Range
    Dim i As Long

' Set the references to the worksheets
    Set wsComparisonReport = ThisWorkbook.Worksheets("comparison report")
    Set wsCPK_Mola_Pivot = ThisWorkbook.Worksheets("cpk_mola_pivot")

' Set the reference to the pivot table
    Set mypivotTable = wsCPK_Mola_Pivot.PivotTables("cpk_mola_pivottable")

' Find the last rows in the Comparison Report and Pivot Table sheets
    lastRowComparison = wsComparisonReport.Cells(wsComparisonReport.Rows.Count, "J").End(xlUp).Row
    lastRowPivot = wsCPK_Mola_Pivot.Cells(wsCPK_Mola_Pivot.Rows.Count, "A").End(xlUp).Row

' Set the ranges for Criteria 1 and Criteria 2
    Set criteria1 = wsComparisonReport.Range("J3:J" & lastRowComparison)
    criteria2 = wsComparisonReport.Range("$O$2").value

' Set the result range in the Comparison Report sheet
    Set resultRange = wsComparisonReport.Range("O3:O" & lastRowComparison)

' Loop through each row in the Comparison Report sheet and use Index-Match to populate the results
    For i = 1 To criteria1.Rows.Count
        resultRange.Cells(i, 1).value = Application.Index(mypivotTable.DataBodyRange.Columns(1).Resize(, 3), _
        Application.Match(criteria1.Cells(i, 1).value, mypivotTable.DataBodyRange.Columns(1), 0), _
        Application.Match(criteria2.value, mypivotTable.DataBodyRange.Columns(2), 0))
    Next i
End Sub

sample of results in pivot enter image description here

sample of sheet "comparison report" enter image description here

Upvotes: 1

Views: 66

Answers (1)

H BG
H BG

Reputation: 81

Sub vlookupwith2criteria()

Dim comparisonSheet As Worksheet
Dim pivotSheet As Worksheet
Dim comparisonData As Variant
Dim pivotData As Variant
Dim comparisonLastRow As Long
Dim pivotLastRow As Long
Dim criteria1Range As Range
Dim criteria2Ranges As Variant
Dim outputRanges As Variant
Dim i As Long, j As Long
Dim criteria1 As String, criteria2 As String
Dim matchFound As Boolean

' Set the sheet references
Set comparisonSheet = ThisWorkbook.Sheets("comparison")
Set pivotSheet = ThisWorkbook.Sheets("datapivot")

' Find the last rows in both sheets
comparisonLastRow = comparisonSheet.Cells(comparisonSheet.Rows.Count, "J").End(xlUp).Row
pivotLastRow = pivotSheet.Cells(pivotSheet.Rows.Count, "A").End(xlUp).Row

' Load data into variant arrays for faster processing
comparisonData = comparisonSheet.Range("A3:C" & comparisonLastRow).value
pivotData = pivotSheet.Range("A1:C" & pivotLastRow).value

' Define the criteria2 and output ranges using arrays
criteria2Ranges = Array(comparisonSheet.Range("$O$2").value, comparisonSheet.Range("$P$2").value, comparisonSheet.Range("$Q$2").value)
outputRanges = Array(comparisonSheet.Range("O3:O" & comparisonLastRow), comparisonSheet.Range("P3:P" & comparisonLastRow), comparisonSheet.Range("Q3:Q" & comparisonLastRow))

' Loop through each month (3 iterations)
For monthIndex = 1 To 3
    Set criteria1Range = comparisonSheet.Range("J3:J" & comparisonLastRow)

    ' Loop through each row in the comparison sheet
    For i = 1 To comparisonLastRow - 2 ' Subtract 2 because the data starts from row 3
        criteria1 = criteria1Range.Cells(i).value
        criteria2 = criteria2Ranges(monthIndex - 1) ' monthIndex - 1 to access the correct criteria2 for the current month
        matchFound = False

        ' Loop through each row in the pivot sheet to find a match for criteria 1 and criteria 2
        For j = 1 To pivotLastRow
            If pivotData(j, 1) = criteria1 And pivotData(j, 2) = criteria2 Then
                ' Match found, populate the value from Column C on the comparison sheet
                outputRanges(monthIndex - 1).Cells(i).value = pivotData(j, 3)
                matchFound = True
                Exit For ' Exit the loop once a match is found
            End If
        Next j

        ' If no match is found for criteria 1 and criteria 2, clear the output cell
        If Not matchFound Then
            outputRanges(monthIndex - 1).Cells(i).value = ""
        End If
    Next i
Next monthIndex

' Clear the memory for the variant arrays
Erase comparisonData
Erase pivotData

End Sub

Upvotes: 0

Related Questions