Can anyone assist on how to amend a macro to compare on 1 sheet only.

[ghrek]

Hi

I have this macro that was given to me and im trying to get it set up so that i can run it on one sheet only.

Sub compare_data()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim i As Long, j As Long, lr As Long
    
    Set sh1 = ActiveWorkbook.Sheets("Sheet1")
    Set sh2 = ActiveWorkbook.Sheets("Sheet2")
       
    Application.ScreenUpdating = False
    lr = sh1.Range("A" & sh1.Rows.Count).End(xlUp).Row
    For i = 2 To lr
        Application.StatusBar = "Checking row : " & i & " of : " & lr
        j = Application.CountIfs(sh2.Columns("A"), sh1.Cells(i, "A").Value, sh2.Columns("B"), sh1.Cells(i, "B").Value, sh2.Columns("C"), sh1.Cells(i, "C").Value, _
            sh2.Columns("D"), sh1.Cells(i, "D").Value)
        Select Case j
        Case 0
            sh1.Cells(i, "E").Value = "MISSING"
        Case 1
            sh1.Cells(i, "E").Value = "OK"
        Case Is > 1
            sh1.Cells(i, "E").Value = "DUPLICATE"
        End Select
    Next
    MsgBox "Done"
End Sub

Can this be done?

Thanks

 

[DanteAmor]

Try this:

Sub compare_data()
    Dim sh1 As Worksheet, i As Long, j As Long
    
    Set sh1 = ActiveWorkbook.Sheets("Sheet1")
       
    Application.ScreenUpdating = False
    For i = 2 To sh1.Range("A" & sh1.Rows.Count).End(xlUp).Row
        Application.StatusBar = "Checking row : " & i & " of : " & lr
        j = Application.CountIfs(sh1.Columns("A"), sh1.Cells(i, "A").Value, sh1.Columns("B"), sh1.Cells(i, "B").Value, _
            sh1.Columns("C"), sh1.Cells(i, "C").Value, sh1.Columns("D"), sh1.Cells(i, "D").Value)
        Select Case j
            Case 0:         sh1.Cells(i, "E").Value = "MISSING"
            Case 1:         sh1.Cells(i, "E").Value = "OK"
            Case Is > 1:    sh1.Cells(i, "E").Value = "DUPLICATE"
        End Select
    Next
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

Or this:

Sub Macro8()
    With Sheets("Sheet1").Range("E2:E" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row)
        .FormulaR1C1 = _
        "=IF(COUNTIFS(C[-4],RC[-4],C[-3],RC[-3],C[-2],RC[-2],C[-1],RC[-1])=1,""OK"",""DUPLICATE"")"
        .Value = .Value
    End With
End Sub