Macros Question

I want to compare two workbooks. If information was included in a row on the old log, and then erased on the new log, I want to see it highlighted. Thanks!
Member_2_7970183Asked:
Who is Participating?
 
xtermieConnect With a Mentor Commented:
try this macro..you can substitute for your sheet names and column/row constants

Sub HighlightDuplicateDifferences5()
    Const ID_COL As Integer = 5     'OrderNo is in the fifth column
    Const ID_COL2 As Integer = 4    'Item is in the fourth column
    Const NUM_COLS As Integer = 21  'how many columns are being compared?
    Const NUM_ROWS As Integer = 7   'how many rows in Sheet1
    Const NUM_ROWS2 As Integer = 7  'how many rows in Sheet2
    
    Dim shtNew As Excel.Worksheet, shtOld As Excel.Worksheet
    Dim rwNew As Range, rwOld As Range, Rng, f As Range
    Dim x As Integer, Id
    Dim prd1, prd2 As String

    Set shtNew = ActiveWorkbook.Sheets("Sheet2")
    Set shtOld = ActiveWorkbook.Sheets("Sheet1")
    
    Set rwNew = shtNew.Rows(2) 'first order on "current" sheet
      
    Do While rwNew.Cells(ID_COL).Value <> ""
        Id = rwNew.Cells(ID_COL).Value          'Set SO we are looking for
        prd1 = rwNew.Cells(ID_COL2).Value       'Set Item we are looking for
        For i = 1 To NUM_ROWS
             If (shtOld.Cells(i, ID_COL).Value = Id) And (shtOld.Cells(i, ID_COL2).Value = prd1) Then
                myrow = i
                Exit For
            End If
        Next i
       
        Set f = shtOld.UsedRange.Rows(myrow)

        If Not f Is Nothing Then
            Set rwOld = f.EntireRow
            prd2 = rwOld.Cells(ID_COL2).Value
            If prd1 = prd2 Then
            For x = 1 To NUM_COLS
                    If rwNew.Cells(x).Value <> rwOld.Cells(x).Value Then
                          If IsEmpty(rwNew.Cells(x).Value) Then rwNew.Cells(x).Interior.Color = RGB(204, 236, 255) 'value is empty in new sheet
                          rwNew.Cells(x).Font.Color = RGB(255, 0, 0)  'value is different
                    Else
                         rwNew.Cells.Interior.ColorIndex = xlNone
                    End If
                Next x
                End If
         End If
         Set rwNew = rwNew.Offset(1, 0) 'next row to compare
    Loop
'Check for New records
    Set rwNew = shtNew.Rows(2) 'first order on "current" sheet
    Do While rwNew.Cells(ID_COL).Value <> ""
        Id = rwNew.Cells(ID_COL).Value
        Set f = shtOld.UsedRange.Columns(ID_COL).Find(Id, , xlValues, xlWhole)
        If f Is Nothing Then rwNew.Cells(ID_COL).Interior.Color = vbGreen 'new order no
        Set rwNew = rwNew.Offset(1, 0) 'next row to compare
    Loop
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
Please attach a workbook that includes an example of what the output should look like.
1
 
xtermieCommented:
question answered in macro provided
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.