Hi I have the following macro but it don't seem to be doing what I want it to.
When it shows Missing or OK that's fine but its when I get duplicated in Watford and zero values.
I need it to show only the duplicated entry once as I have some that show duplicated entry twice and others only once. Also I need it to delete entries where value is ZERO on all of the entries. Like the one below they are both duplicated BUT one shows it twice and one shows once.
Macro below..
When it shows Missing or OK that's fine but its when I get duplicated in Watford and zero values.
I need it to show only the duplicated entry once as I have some that show duplicated entry twice and others only once. Also I need it to delete entries where value is ZERO on all of the entries. Like the one below they are both duplicated BUT one shows it twice and one shows once.
1382 | 23 | 09/01/2021 | £2.70 | DUPLICATED IN WATFORD |
1382 | 36 | 03/12/2020 | £1.00 | DUPLICATED IN WATFORD |
1382 | 36 | 03/12/2020 | £1.00 | DUPLICATED IN WATFORD |
Macro below..
VBA Code:
Sub compare_data()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long, j As Long, lr As Long
Set sh1 = ActiveWorkbook.Sheets("TAB")
Set sh2 = ActiveWorkbook.Sheets("WFJ")
Application.ScreenUpdating = False
lr = sh1.Range("A" & sh1.Rows.Count).End(xlUp).Row
For i = 1 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 = "DUPLICATED IN WATFORD"
End Select
Next
Last = Cells(Rows.Count, "D").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "D").Value) = "0.00" Then
'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW
Cells(i, "A").EntireRow.Delete
End If
Next i
MsgBox "Done"
End Sub