Looking to speed up modified countif using VBA

Good Afternoon,

I am looking to speed up a portion of a macro where I am basically looking to create a unique ID for duplicate values. The following formula is currently being used on a dynamic range of ~21k rows and then converted to value. Any help would be greatly appreciated. Thank you!

Sub ColumnW_Test()

'Enter formula and fill down
Range("W4").Formula = "=V4&""-""&COUNTIF($V$4:V4,V4)"
Range("W4:W21364").FillDown

'Copy/paste values to end of data
Range("W4", "W" & Cells(Rows.Count, 3).End(xlUp).Row).Copy
Range("W4").PasteSpecial xlPasteValues
Application.CutCopyMode = False


Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.StatusBar = False

EndTime = Timer
MsgBox "This took " & EndTime - StartTime & " seconds to run"

End Sub

How about

Sub MakeUnique()
   Dim i As Long
   Dim Ary As Variant
   
   Ary = Range("V4", Range("V" & Rows.Count).End(xlUp).Offset(, 1)).value2
   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(Ary)
         .Item(Ary(i, 1)) = .Item(Ary(i, 1)) + 1
         Ary(i, 2) = Ary(i, 1) & "-" & .Item(Ary(i, 1))
      Next i
   End With
   Range("W4").Resize(UBound(Ary)).Value = Application.Index(Ary, 0, 2)
End Sub

That is awesome! Works perfectly. I am new to coding so I really appreciate it. Thank you.

Glad to help & thanks for the feedback.

Also welcome to the board.

Hi Fluff13,

How are you? I hope all is well. I'm having an issue with a vba code you helped me with about 2-3 weeks ago. The code is re-pasted below.

The original file that was used with this code was updated (meaning we cleared out the previous months data and are now using current month data). I'm getting a type mismatch 13 error on the following line: Ary(i, 2) = Ary(i, 1) & "-" & .Item(Ary(i, 1)).

I'm not entirely familiar with scripting dictionaries and/or if there is something else that would be causing this error. I assumed I could just keep recycling/reusing the code each month as new data arrives. Any help would be greatly appreciated. Thank you.

Sub MakeUnique()
   Dim i As Long
   Dim Ary As Variant
   
   Ary = Range("V4", Range("V" & Rows.Count).End(xlUp).Offset(, 1)).value2
   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(Ary)
         .Item(Ary(i, 1)) = .Item(Ary(i, 1)) + 1
         Ary(i, 2) = Ary(i, 1) & "-" & .Item(Ary(i, 1))  'type mismatch error occurs here
      Next i
   End With
   Range("W4").Resize(UBound(Ary)).Value = Application.Index(Ary, 0, 2)
End Sub

Originally Posted by nickytraps

Hi Fluff13,

How are you? I hope all is well. I'm having an issue with a vba code you helped me with about 2-3 weeks ago. The code is re-pasted below.

The original file that was used with this code was updated (meaning we cleared out the previous months data and are now using current month data). I'm getting a type mismatch 13 error on the following line: Ary(i, 2) = Ary(i, 1) & "-" & .Item(Ary(i, 1)).

I'm not entirely familiar with scripting dictionaries and/or if there is something else that would be causing this error. I assumed I could just keep recycling/reusing the code each month as new data arrives. Any help would be greatly appreciated. Thank you.

Sub MakeUnique()
   Dim i As Long
   Dim Ary As Variant
   
   Ary = Range("V4", Range("V" & Rows.Count).End(xlUp).Offset(, 1)).value2
   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(Ary)
         .Item(Ary(i, 1)) = .Item(Ary(i, 1)) + 1
         Ary(i, 2) = Ary(i, 1) & "-" & .Item(Ary(i, 1))  'type mismatch error occurs here
      Next i
   End With
   Range("W4").Resize(UBound(Ary)).Value = Application.Index(Ary, 0, 2)
End Sub

Maybe version your excel until excel 2013
If using transpose and index Only 65.000 row
Try fluff code

Sub MakeUnique()
   Dim i As Long
   Dim Ary As Variant
   Dim arr()
   
   Ary = Range("V4", Range("V" & Rows.Count).End(xlUp).Offset(, 1)).value
   Redim arr(1 to ubound(Ary),1 to 1)
   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(Ary)
         .Item(Ary(i, 1)) = .Item(Ary(i, 1)) + 1
         Arr(i, 1) = Ary(i, 1) & "-" & .Item(Ary(i, 1))  'type mismatch error occurs here
      Next i
   End With
   Range("W4").Resize(UBound(Ary)).Value = Arr
End Sub

When it fails what is the value of i?
Add 3 to that value & then look in col V for that row number, what is in the cell?
For instance if i is 5 what is in V8

Originally Posted by Fluff13

When it fails what is the value of i?
Add 3 to that value & then look in col V for that row number, what is in the cell?
For instance if i is 5 what is in V8

Sorry I just realized that there may be issues with the data. The first error occurs at the 7,162nd item which is #N/A. That should not be. Let me look into this further. Thank you.

It's the #N/A that's causing the problem.

This code works, however I am trying to reuse this code in another workbook. I thought it would be as simple as updating the range(s) but apparently not. Would anyone happen know what is causing this? Thank you!

Option Explicit

Sub Unique_Id()

   Dim i As Long
   Dim Ary As Variant
   
   

   Ary = Range("J2", Range("J" & Rows.Count).End(xlUp).Offset(, 1)).Value2
 
   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(Ary)
         .Item(Ary(i, 1)) = .Item(Ary(i, 1)) + 1
       Ary(i, 2) = Ary(i, 1) & "-" & .Item(Ary(i, 1))
      Next i
   End With
   Range("K2").Resize(UBound(Ary)).Value = Application.Index(Ary, 0, 2) ' Run time error 13 Type mismatch


End Sub

How many rows of data do you have?

Went from originally about 21k to now 130k in the new workbook.

In that case try the code daboho supplied in post#9

I think that works. Testing now. Thanks again Fluff13, you too daboho.

You're welcome