Sequence each duplicate value in multi columns (Scripting Dictionary)

[SamKhem]

Dear All Senior Members

I am new member in this thread. I would like to request you guide as vba with Sequence each duplicate value in multi columns (Scripting Dictionary).
Example:
Col. A Col.B Result: Col. C Col. D
aa cc 1 2
bb dd 1 2
cc aa 1 3
dd bb 1 2
aa dd 2 3

Thank in advance for your assist.
Best regards,

 

[Peter_SSs]

Welcome to the MrExcel board!

Dear All Senior Members

Surely a junior member with a good solution would be just as good?

Unless this is an assignment or test question, why specify Scripting Dictionary?
This seems to do what you want without the need for it.

Sub test()
  Dim lr As Long
  
  lr = Columns("A:B").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  With Range("C1:D" & lr)
    .Columns(1).FormulaR1C1 = "=IF(RC1="""","""",COUNTIF(R1C1:RC1,RC1))"
    .Columns(2).FormulaR1C1 = "=IF(RC2="""","""",COUNTIF(R1C1:R" & lr & "C1,RC2)+COUNTIF(R1C2:RC2,RC2))"
    .Value = .Value
  End With
End Sub

Here is my sheet after the code has run.
BTW, I suggest that you investigate XL2BB for providing sample data in the future.

SamKhem.xlsm
	A	B	C	D
1	aa	cc	1	2
2	bb	dd	1	2
3	cc	aa	1	3
4	dd	bb	1	2
5	aa	dd	2	3
Sheet1

 

[SamKhem]

Welcome to the MrExcel board!


Surely a junior member with a good solution would be just as good?

Unless this is an assignment or test question, why specify Scripting Dictionary?
This seems to do what you want without the need for it.

Sub test()
  Dim lr As Long
 
  lr = Columns("A:B").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  With Range("C1:D" & lr)
    .Columns(1).FormulaR1C1 = "=IF(RC1="""","""",COUNTIF(R1C1:RC1,RC1))"
    .Columns(2).FormulaR1C1 = "=IF(RC2="""","""",COUNTIF(R1C1:R" & lr & "C1,RC2)+COUNTIF(R1C2:RC2,RC2))"
    .Value = .Value
  End With
End Sub

Here is my sheet after the code has run.
BTW, I suggest that you investigate XL2BB for providing sample data in the future.

SamKhem.xlsm
	A	B	C	D
1	aa	cc	1	2
2	bb	dd	1	2
3	cc	aa	1	3
4	dd	bb	1	2
5	aa	dd	2	3
Sheet1

Thank so much Peter, Really appreciate your feedback, actually I need vba with scripting dictionary because I need to run vba million rows with multi columns.

 

[Peter_SSs]

I need vba with scripting dictionary because I need to run vba million rows with multi columns.

OK, try something like this

Sub test2()
  Dim d As Object
  Dim a As Variant
  Dim lr As Long, i As Long, j As Long, uba1 As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  lr = Columns("A:B").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  With Range("A1:B" & lr)
   a = .Value
   uba1 = UBound(a, 1)
   For j = 1 To UBound(a, 2)
    For i = 1 To uba1
      If Len(a(i, j)) > 0 Then
        d(a(i, j)) = d(a(i, j)) + 1
        a(i, j) = d(a(i, j))
      End If
    Next i
   Next j
   .Offset(, .Columns.Count).Value = a
  End With
End Sub

 

[SamKhem]

OK, try something like this

Sub test2()
  Dim d As Object
  Dim a As Variant
  Dim lr As Long, i As Long, j As Long, uba1 As Long
 
  Set d = CreateObject("Scripting.Dictionary")
  lr = Columns("A:B").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  With Range("A1:B" & lr)
   a = .Value
   uba1 = UBound(a, 1)
   For j = 1 To UBound(a, 2)
    For i = 1 To uba1
      If Len(a(i, j)) > 0 Then
        d(a(i, j)) = d(a(i, j)) + 1
        a(i, j) = d(a(i, j))
      End If
    Next i
   Next j
   .Offset(, .Columns.Count).Value = a
  End With
End Sub

Great support.
Best wish
Have a nice weekend.

 

[Peter_SSs]

Cheers. Thanks for the follow-up.