VBa - Quickest Way to put 0’s where these are duplicated

[Sahil123]

Hi

i have a dataset where there could some duplicates

if the name and date matches then put a 0 in that row (only duplicated row)

eg
DateTime, Name, Location, Time, Time2, Subject, Time3

27/07/2020 09:00, Simon, London, 03:50:00, 01:00:00, English, 02:00:00

27/07/2020 09:00, Simon, Liverpool , 03:50:00, 01:00:00, English, 02:00:00

The data should in that example look like this


27/07/2020 09:00, Simon, London, 03:50:00, 01:00:00, English, 02:00:00

27/07/2020 09:00, Simon, Liverpool , 0, 0, English, 0

Hope this makes sense

 

[Sahil123]

Ive seen this formula but that would mean creating additional columns and on a large dataset could take long so was hoping maybe an array solution or some other sort would be better

I2=IF(SUMPRODUCT(--($A$1:A1=A2),--($B$1:B1=B2)),0,E2)

J2= IF(SUMPRODUCT(--($A$1:A1=A2),--($B$1:B1=B2)),0,F2) etc

K2= IF(SUMPRODUCT(--($A$1:A1=A2),--($B$1:B1=B2)),0,H2) etc

 

[DrParmeJohnson]

Hello,

Assuming this data I have here looks correct, I think this has the effect you're looking for.

Book1
	A	B	C	D	E	F	G
1	DateTime	Name	Location	Time	Time2	Subject	Time3
2	27/07/2020	Simon	London	3:50:00	1:00:00	English	2:00:00
3	27/07/2021	Simon	Liverpool	3:50:00	1:00:00	English	3:00:00
Sheet1

Sub InsZeroes()

Dim c As Range, LR As Integer, ws1 As Worksheet

Set ws1 = ActiveSheet

LR = ws1.Cells(Rows.Count, "A").End(xlUp).Row

For Each c In ws1.Range("A2:A" & LR)
    If c.Value = c.Offset(1, 0).Value And c.Offset(0, 1).Value = c.Offset(1, 1).Value Then
        c.Offset(1, 3).Value = 0
        c.Offset(1, 3).NumberFormat = "General"
        c.Offset(1, 4).Value = 0
        c.Offset(1, 4).NumberFormat = "General"
        c.Offset(1, 6).Value = 0
        c.Offset(1, 6).NumberFormat = "General"
    End If
Next c

End Sub

 

[Sahil123]

Hi

Thank you

that wont work as that would mean data is sorted

the data could come in an un sorted format

 

[Fluff]

How about

Sub Sahil()
   Dim Cl As Range
   Dim Tmp As String
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         Tmp = Cl.Value2 & "|" & Cl.Offset(, 1).Value
         If Not .exists(Tmp) Then
            .Add Tmp, Nothing
         Else
            Cl.Offset(, 3).Resize(, 2).Value = 0
            Cl.Offset(, 6).Value = 0
         End If
      Next Cl
   End With
End Sub

 

[Sahil123]

Thank you sooo much

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[Sahil123]

Do i need to set a reference from tools reference to the scripting library?

 

[Fluff]

Nope, the code uses what's called late binding, so no need for references.

 

[Sahil123]

Thank you