VBA - Highlight Pivot Table cell (Marker)

[AlliancePugs]

I am using this VBA code to automatically put an "X" in your detailed data sheet ("RawData") for each row that matches a highlighted pivot table cell. Specifically, when I highlight pivot cells green, the macro looks for rows in the RawData then marks them as selected. But I am currently facing issues that not all records are not being marked. Need help with this.

Sub MarkRawDataForGreenCells()
Dim wsPivot As Worksheet, wsData As Worksheet
Dim pt As PivotTable
Dim cell As Range, dataCell As Range
Dim dataRng As Range
Dim lastRow As Long
Dim pivotCode As Variant, pivotSource As Variant, pivotAmount As Double
Dim matched As Boolean

' Set worksheets
Set wsPivot = ThisWorkbook.Sheets("Pivot") ' Pivot Table sheet
Set wsData = ThisWorkbook.Sheets("RawData") ' Raw Data sheet

' Identify last row in RawData
lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
Set dataRng = wsData.Range("A1:Z" & lastRow) ' Adjust range for raw data

' Clear previous selections in "Selected" column (Column Z)
wsData.Range("M2:M" & lastRow).ClearContents ' Adjust column if needed

' Loop through Pivot Table cells
For Each cell In wsPivot.UsedRange
' Check if the cell is highlighted green
If cell.Interior.Color = RGB(0, 255, 0) Then
' Get Pivot Table object
On Error Resume Next
Set pt = cell.PivotTable
On Error GoTo 0

' If the cell is part of a Pivot Table
If Not pt Is Nothing Then
pivotAmount = cell.Value ' Get the highlighted value (Amount)

' Find related fields dynamically
pivotCode = cell.EntireRow.Cells(1, 1).Value ' "Code" is always in the first column
pivotSource = cell.EntireRow.Cells(1, 2).Value ' "Source" is the second column

' Check if Source is one of the required values
If pivotSource = "IVET" Or pivotSource = "BANK" Or pivotSource = "ACCRUAL" Or pivotSource = "Gen" Then
matched = False

' Loop through RawData to find matching entries
For Each dataCell In dataRng.Columns(1).Cells ' Column A = Code
If dataCell.Value = pivotCode And dataCell.Offset(0, 5).Value = pivotSource Then ' Column F = Source
If dataCell.Offset(0, 6).Value = pivotAmount Then ' Column G = Amount
dataCell.Offset(0, 12).Value = "X" ' Mark "Selected" column (Column Z)
matched = True
End If
End If
Next dataCell

' Debugging: Log unmatched values
If Not matched Then
Debug.Print "No match found for Code: " & pivotCode & ", Source: " & pivotSource & ", Amount: " & pivotAmount
End If
End If
End If
End If
Next cell

MsgBox "Raw data updated based on green-highlighted Pivot Table cells.", vbInformation
End Sub

 

[Sam_D_Ben]

Both images are missing visible row and column names. Additionally, there are no debugging logs provided, which makes it harder to trace the issue.

 

[Alex Blakenburg]

In case its an easy fix, try changing the first line with the 2nd line below:

                            'If dataCell.Offset(0, 6).Value = pivotAmount Then ' Column G = Amount
                            If Abs(dataCell.Offset(0, 6).Value - pivotAmount) < 0.01 Then ' Column G = Amount

 

[Sam_D_Ben]

May be you can try this code and see whats happening on your file,

Sub testGreenPivotCells()
    Dim wsPivot As Worksheet, wsData As Worksheet
    Dim pt As PivotTable
    Dim cell As Range, dataCell As Range
    Dim lastRow As Long
    Dim code As Variant, source As Variant, matchDate As Variant
    Dim i As Long
    Dim foundCode As Boolean
    Dim matchCount As Long

    Set wsPivot = ThisWorkbook.Sheets("Pivot")
    Set wsData = ThisWorkbook.Sheets("RawData")

    On Error Resume Next
    Set pt = wsPivot.PivotTables(1)
    On Error GoTo 0

    If pt Is Nothing Then
        MsgBox "No pivot table found on the Pivot sheet.", vbCritical
        Exit Sub
    End If

    lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    wsData.Range("M2:M" & lastRow).ClearContents

    matchCount = 0

    For Each cell In pt.DataBodyRange
        If cell.Interior.Color = RGB(0, 255, 0) Then
            Debug.Print "--------"
            Debug.Print "Checking cell: " & cell.Address & " Value: " & cell.Value

            matchDate = wsPivot.Cells(4, cell.Column).Value
            Debug.Print "Date from header: " & matchDate

            foundCode = False
            For i = cell.Row To 1 Step -1
                If IsNumeric(wsPivot.Cells(i, 1).Value) Then
                    code = wsPivot.Cells(i, 1).Value
                    foundCode = True
                    Exit For
                End If
            Next i

            If Not foundCode Then
                Debug.Print "No code found above cell " & cell.Address
                GoTo NextCell
            End If

            source = wsPivot.Cells(cell.Row, 1).Value
            Debug.Print "Found Code: " & code & ", Source: " & source

            For Each dataCell In wsData.Range("A2:A" & lastRow)
                If dataCell.Value = code And _
                   dataCell.Offset(0, 5).Value = source And _
                   Format(dataCell.Offset(0, 4).Value, "mm/dd/yyyy") = Format(matchDate, "mm/dd/yyyy") Then
                    dataCell.Offset(0, 12).Value = "X"
                    matchCount = matchCount + 1
                    Debug.Print "? Matched at RawData Row " & dataCell.Row
                End If
            Next dataCell
        End If
NextCell:
    Next cell

    
End Sub