CODEWITHSUNDEEP
excelexcel-2010vba
honey
honey

Reputation: 199

how to compare data between two pivots and change color if any mismatch is there?

I created a macro to create a pivot for the data present in the sheet named "data". and the same for data present in the sheet "record". the content of these sheets is comparable everytime. I want to write a macro to change the color of the cells if there is any mismatch in these two sheets.

say in data sheet there are 50 rows and in record sheet there are 52 rows. then i want to write a macro that the two mismatched rows in record sheet should be Red and rest 50 should be green.

Any help would be appreciated.

My code: to create pivot is

Dim bReport As Workbook, Report As Worksheet, pivotSheet As Worksheet     
Set bReport = Excel.ActiveWorkbook
Set Report = bReport.Worksheets("data") 
Set pivotSheet = bReport.Worksheets.Add 

Dim pivotSource As Range 
Set pivotSource = Report.UsedRange 'selecting entire data in the sheet

Dim tableName As String
tableName = "Pivot_Data"  

bReport.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=pivotSource).CreatePivotTable _
    TableDestination:=pivotSheet.Cells(1, 1), tableName:=tableName

Set pt = pivotSheet.PivotTables(tableName)
pivotSheet.PivotTableWizard TableDestination:=pivotSheet.Cells(1, 1)
Set pOne= pt.PivotFields("Number")
Set pTwo = pt.PivotFields("Premium")
Set pthree = pt.PivotFields("TransactoinID")
Set pFour = pt.PivotFields("money")

pOne.Orientation = xlRowField 
pTwo.Orientation = xlRowField
pTwo.Subtotals(1) = False 
pThree.Orientation = xlRowField
pThree.Subtotals(1) = False
pFour.Orientation = xlDataField
pFour.NumberFormat = "$#,##0.00"

the same code i wrote for record sheet also.

I tried this code for color change but getting object 438 error in If condition. Is this wrong approach to solve my problem or any improvement can be happen? 

Sub abc()
Dim rCell As Range

For Each rCell In Sheet1.Cells  'or Sheet1.Range("A1:D2").Cells
    If rCell.Value2 <> Sheet2.Range(rCell.AddressLocal).Value2 Then
        With rCell.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535 'YELLOW, make this the color of your choice
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        With Sheet2.Range(rCell.AddressLocal).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65500 'YELLOW, make this the color of your choice
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
Next rCell
End Sub

Upvotes: 2

Views: 823

Answers (1)

K_B
K_B

Reputation: 3678

You can either use conditional formatting OR scripted comparison for this:

Conditional formatting will keep checking for differences, you can apply the conditional formatting to either or both sheets and just refer to the same cell on the other sheet, when unequal set background color. To make this easiest just apply the same conditional formatting in 1 go to the whole range of cells (maybe even the complete sheet) and have the comparison set for the top left most cell (take out the dollar signs to have the formatting formula move along with the member cells)

Scripted comparison will require you to apply a little piece of VBA code where you for example iterate over all cells (other might have more elegant/efficient solutions), something like this (untested):

Dim rCell as Range

For each rCell in Sheet1.Range("A1:D2").Cells 'Or Sheet1.Cells
    If rCell.Value2 <> Sheet2.Range(rCell.AddressLocal).Value2 Then
        With rCell.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535 'YELLOW, make this the color of your choice
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        With Sheet2.Range(rCell.AddressLocal).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535 'YELLOW, make this the color of your choice
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
Next rCell

Upvotes: 1

Related Questions