How do I identify identical rows in Excel or VBA

[twinkle99]

I have a large data file which has thousands of rows of data.

In Column A is a text string which is the reference number followed by an element. In Column C is the amount of that element and Column D is the date of that element.

I have written a macro which reads through the data file and finds the data which is relevant to the reference number and date both of which are inputted on another sheet (not supplied).

The problem I have is that in Column A, there may be rows which are identical. The macro looks for the text string, however, I dont know how to get the Macro to distinguish between the identical rows - i.e. 1021#INCV.

An example of the VBA for one input is:

With Application.WorksheetFunction
a.Range("C10") = .Index(b.Range("C:C"), .Match(b.Range("C11").Value & "#INCV", s, 0))

C:C - is the result that I want - the amount
C11 - is the reference number
s - is Column A:A where the text string will be

Basically, the macro should find the text string, check whether the date in D:D is before the calculation date (input on another sheet) and if it isnt, it should move to the next string and check the date etc until it finds the one which is before. However, it doesnt work because the macro just finds the first line every time (because the other INCV's are identical)

Is there a way of either writing an excel formula in Column B which will rename the identical rows when they occur i.e. 1021#INCV2, then 1021#INCV3 etc. Note that the elements for each member can appear in any row and are not necessarily in the same place, The dates and amounts will also be different. So members may return more rows than others. If this is possible I can just look for the different text strings in the macro.

Alternatively, is there a way of doing something in the Macro?

I have supplied a very short piece of the data file.

Thanks

vba test.xls
	A	B	C	D
1	1021#INCV		1600	18/09/2005
2	1021#CA04		20	18/09/2005
3	1021#ADP		620	18/09/2005
4	1021#INCV		1452	20/09/2004
5	1021#CA04		15	20/09/2004
6	1021#ADP		88	20/09/2004
7	1021#CA04		90	17/09/2003
8	1021#ADP		33	17/09/2003
9	1021#INCV		1200	17/09/2003
10	1021#INCV		1166	16/08/2002
11	1021#INCV		1020	15/08/2001
12	1021#INCV		950	16/01/2000
13	1569#INCV		1560	18/09/2005
14	1569#CA05		200	18/09/2005
15	1569#ADP		615	18/09/2005
16	1569#INCV		1500	20/09/2004
17	1569#CA05		150	20/09/2004
18	1569#ADP		595	20/09/2004
19	1569#CA05		90	17/09/2003
20	1569#ADP		500	17/09/2003
21	1569#INCV		1400	17/09/2003
22	1569#INCV		1333	12/08/2002
Sheet1

 

[venkat1926]

why not sort both the sheets on the same criteria so that row to row correspondence in the two sheets is not lost. The sorting may be required to find the mutiple values of the same e.g. INCV. anoher way without sorting I can attempt somesort of filter. . I shall think abut all these thingsmeanwhiel post an extract of the other sheet also.
venkat

 

[Dufus]

twinkle99,

Don't wish to step on any toes here so, just ignore if you want.

It seems to me that you want to end up with a list that looks like this.
1) Give me the unique values in column A in one column.
2) Give me the amount associated with the first column that meets a date criteria in the fourth column.

If you generate the unique list or have it already and you have the date criteria in the fourth column, you can use a formula to find the corresponding amount like so.

=SUMPRODUCT(--($A$2:$A$27=F2),$C$2:$C$27*1,--($D$2:$D$27=I2))

Assume your original data is in columns A:D and the unique list is in column F and the date you want is in column I and you enter the formula in column H. Copy the formula down.

Dufus

 

[twinkle99]

please find sheet 1 which is an extract of the data file for the first 26 rows.

Dufus, thanks for your input

vba test.xls
	A	B	C	D
1	1569	INCV	1560	18/09/2005
2	1569	CA05	200	18/09/2005
3	1569	ADP	615	18/09/2005
4	1569	INCV	1500	20/09/2004
5	1569	CA05	150	20/09/2004
6	1569	ADP	595	20/09/2004
7	1569	INCV	1400	17/09/2003
8	1569	CA05	90	17/09/2003
9	1569	ADP	500	17/09/2003
10	1569	INCV	1333	12/08/2002
11	1021	INCV	1600	18/09/2005
12	1021	CA04	20	18/09/2005
13	1021	ADP	620	18/09/2005
14	1021	INCV	1452	20/09/2004
15	1021	CA04	15	20/09/2004
16	1021	ADP	88	20/09/2004
17	1021	CA04	90	17/09/2003
18	1021	ADP	33	17/09/2003
19	1021	INCV	1200	17/09/2003
20	1021	INCV	1166	16/08/2002
21	1021	INCV	1020	15/08/2001
22	1021	INCV	950	16/01/2000
23	56233	INCV	233	18/09/2005
24	56233	ADP	50	18/09/2005
25	56233	INCV	200	17/09/2004
26	56233	INCV	163	16/09/2003
Sheet1

 

[jindon]

Sorry, what I meant to do is like this with your first sample data.
Can you post the desired result out of your last sample?

Sub test()
Dim a, i As Long, dic As Object, txt As String, myNum As Long
a = Range("a1",Range("a" & Rows.Count).End(xlUp)).Value
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
With CreateObject("VBScript.RegExp")
   For i = 1 To UBound(a,1)
      If Not IsEmpty(a(i,1)) Then
         .Pattern = "\d+$"
         txt = .replace(Trim(a(i,1)),"")
         If .test(a(i,1)) Then
            myNum = .execute(Trim(a(i,1)))(0)
         Else
            myNum = 0
         End If
         If Not dic.exists(txt) Then
            dic.add txt, myNum
         Else
            a(i,1) = txt & dic(txt) + 1
            dic(txt) = dic(txt) + 1
         End If
      End If
   Next
End With
Range("a1").Resize(UBound(a,1),UBound(a,2)).Value = a
Set dic = Nothing
End Sub

 

[venkat1926]

try this macro. if there is any bug in using this macro in your extended sheet let me know.

first run the macro on the extact you have sent and if it is ok do it for exteded sheet.( naturally you must keep the orginal sheet somewhere safe)

If you want to see my line of thinking do step by step debugging. That means keep the cursor within the macro and succesively hit F8. (while doing this keep the sheet and macro side by side to see what happens in the sheet at sucessive steps)

the macro is

Sub serialnos()
Dim rng, rng1, c As Range
Dim i, j, k As Integer
Columns("e:e").Delete
i = 0
Set rng = Range([B1], [B1].End(xlDown))
'MsgBox rng.Address
For Each c In rng
i = i + 1
c.End(xlToRight).Offset(0, 1) = i
Next c
Set rng1 = Range([a1], [a1].End(xlDown).End(xlToRight))
'MsgBox rng1.Address
rng1.Sort order1:=xlAscending, key1:=Range("B1"), order2:=xlDescending, _
    key2:=Range("D1"), order3:=xlAscending, key3:=Range("c1"), header:=xlNo
    i = 0
j = ActiveSheet.UsedRange.Rows.Count
'MsgBox j
For k = 1 To j
If Cells(k, "b") = Cells(k + 1, "b") Then
i = i + 1
 Cells(k, "f") = Cells(k, "b") & " " & i
Else
Cells(k, "f") = Cells(k, "b") & " " & i + 1
 i = 0
 End If
 Next
 Set rng1 = Range([a1], [a1].End(xlDown).End(xlToRight))
 rng1.Sort key1:=Range("E1")
Columns("e:e").Delete
MsgBox "the macro is over"
End Sub

 

[twinkle99]

Thanks guys,

Jindon, your code works as intended except where the text string ends in a number. see below, I have provided the actual data in Column A, the expected results in column B and the your code results in Column C. As you can see, the elements of CA05 and CA04 have given incorrect results. INCV and ADP are all correct.

Could you please take a look at this.

vba test.xls
	A	B	C	D
1	ActualData	ExpectedResult	JindonResult
2	1569#INCV	1569#INCV	1569#INCV
3	1569#CA05	1569#CA05	1569#CA05
4	1569#ADP	1569#ADP	1569#ADP
5	1569#INCV	1569#INCV1	1569#INCV1
6	1569#CA05	1569#CA051	1569#CA6
7	1569#ADP	1569#ADP1	1569#ADP1
8	1569#INCV	1569#INCV2	1569#INCV2
9	1569#CA05	1569#CA052	1569#CA7
10	1569#ADP	1569#ADP2	1569#ADP2
11	1569#INCV	1569#INCV3	1569#INCV3
12	1021#INCV	1021#INCV	1021#INCV
13	1021#CA04	1021#CA04	1021#CA04
14	1021#ADP	1021#ADP	1021#ADP
15	1021#INCV	1021#INCV1	1021#INCV1
16	1021#CA04	1021#CA041	1021#CA5
17	1021#ADP	1021#ADP1	1021#ADP1
18	1021#CA04	1021#CA042	1021#CA6
19	1021#ADP	1021#ADP2	1021#ADP2
20	1021#INCV	1021#INCV2	1021#INCV2
21	1021#INCV	1021#INCV3	1021#INCV3
22	1021#INCV	1021#INCV4	1021#INCV4
23	1021#INCV	1021#INCV5	1021#INCV5
24	56233#INCV	56233#INCV	56233#INCV
25	56233#ADP	56233#ADP	56233#ADP
26	56233#INCV	56233#INCV1	56233#INCV1
27	56233#INCV	56233#INCV2	56233#INCV2
test

venkat1926, I am testing your code and will get back to you.

Thanks

 

[jindon]

I see
This should work

Sub test()
Dim a, i As Long, dic As Object, txt As String, myNum As Long
a = Range("a1",Range("a" & Rows.Count).End(xlUp)).Value
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
   For i = 1 To UBound(a,1)
      If Not IsEmpty(a(i,1)) Then
         If Not dic.exists(a(i,1)) Then
            dic.add a(i,1), 0
         Else
            a(i,1) = a(i,1) & dic(a(i,1)) + 1
            dic(a(i,1)) = dic(a(i,1)) + 1
         End If
      End If
   Next
Range("a1").Resize(UBound(a,1)).Value = a
Set dic = Nothing
End Sub

Alternatively following formula should populate the same results

=If(CountIf(A$1:A1,A1)>1,A1&CountIf(A$1:A1,A1)-1,A1)

and copy down

 

[twinkle99]

Hi Jindon

The Excel formula works ok.

The Macro is still not quite working (expected and your results below)

However, thats ok I can use the excel formula, will this work for 22,000 rows??

Thanks

vba test.xls
	A	B	C	D
1	ActualData	Expectedresult	JindonResult
2	1569#INCV	1569#INCV	1569#INCV
3	1569#CA05	1569#CA05	1569#CA05
4	1569#ADP	1569#ADP	1569#ADP
5	1569#INCV	1569#INCV1	1569#INCV1
6	1569#CA05	1569#CA051	1569#CA051
7	1569#ADP	1569#ADP1	1569#ADP1
8	1569#INCV	1569#INCV2	1569#INCV1
9	1569#CA05	1569#CA052	1569#CA051
10	1569#ADP	1569#ADP2	1569#ADP1
11	1569#INCV	1569#INCV3	1569#INCV1
12	1021#INCV	1021#INCV	1021#INCV
13	1021#CA04	1021#CA04	1021#CA04
14	1021#ADP	1021#ADP	1021#ADP
15	1021#INCV	1021#INCV1	1021#INCV1
16	1021#CA04	1021#CA041	1021#CA041
17	1021#ADP	1021#ADP1	1021#ADP1
18	1021#CA04	1021#CA042	1021#CA041
19	1021#ADP	1021#ADP2	1021#ADP1
20	1021#INCV	1021#INCV2	1021#INCV1
21	1021#INCV	1021#INCV3	1021#INCV1
22	1021#INCV	1021#INCV4	1021#INCV1
23	1021#INCV	1021#INCV5	1021#INCV1
24	56233#INCV	56233#INCV	56233#INCV
25	56233#ADP	56233#ADP	56233#ADP
26	56233#INCV	56233#INCV1	56233#INCV1
27	56233#INCV	56233#INCV2	56233#INCV1
Sheet3

 

[jindon]

Formula should work with any length of the row
How about?

Sub test()
Dim a, i As Long, dic As Object
a = Range("a1",Range("a" & Rows.Count).End(xlUp)).Value
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
   For i = 1 To UBound(a,1)
      If Not IsEmpty(a(i,1)) Then
         If Not dic.exists(a(i,1)) Then
            dic.add a(i,1), 0
         Else
            dic(a(i,1)) = dic(a(i,1)) + 1
            a(i,1) = a(i,1) & dic(a(i,1))
         End If
      End If
   Next
Range("a1").Resize(UBound(a,1)).Value = a
Set dic = Nothing
End Sub

 

[twinkle99]

Thanks jindon, works fine now