VBA code to set Name for a dynamic range in one column

[Lifeson]

Hi all,

I am brand new to VBA and only just beginning to learn.

I have 13 columns of data in an Excel sheet. Row numbers vary from 40,000 to 500,000.

Column 13 (M) may contain duplicates which I want to count in column 14 (N) and paste to a new sheet (not delete).

I had attempted to name the range in column M(13) then reference range in a countif or vlookup but since the volume of data varies wildy, I couldn't figure out how to name the range dynamically without referencing the specific cell ranges (M2:M44927) - I need to run this report daily but would prefer to automate with a module (not within an activated worksheet).

Would anyone have some VBA code I could re-use to do this?

 

[steve the fish]

Hi. See if this does it. Change the sheet name to suit your sheet name:

With Sheets("Sheet1")
    lr = .Cells(.Rows.Count, 13).End(xlUp).Row
    ThisWorkbook.Names.Add Name:="NewM", RefersToR1C1:=.Range(.Cells(2, 13), .Cells(lr, 13))
End With

 

[Lifeson]

Thanks steve the fish - that solves that one brilliantly and I even understand what it's doing (but wouldn't have known where to start).

I'm also looking for VBA to look for duplicates in column 13 then spit out a 0 or the number of the duplicate (e.g. the 1st duplicate would be shown as 1 or the second duplicate sown as 2 and so on) in column 14 and wondering if a countif function (filled down) is ok (it's deadly slow)or is there way to do this without a function?

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub Lifeson()
   Dim Ary As Variant, Nary As Variant, Ky As Variant
   Dim r As Long, rr As Long
   
   With Sheets("Sheet1")
      Ary = .Range("M2", .Range("M" & Rows.Count).End(xlUp).Offset(, 1)).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 2)
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         .Item(Ary(r, 1)) = .Item(Ary(r, 1)) + 1
      Next r
      For r = 1 To UBound(Ary)
         Ary(r, 2) = .Item(Ary(r, 1)) + 1
      Next r
      Sheets("Sheet1").Range("M2").Resize(UBound(Ary), 2).Value = Ary
      For Each Ky In .Keys
         If .Item(Ky) = 1 Then
            rr = rr + 1
            Nary(rr, 1) = Ky
         End If
      Next Ky
      Sheets("Sheet2").Range("A2").Resize(rr, 2).Value = Nary
   End With
End Sub

This will fill Col N with the number of times the value exists and will put the duplicates onto sheet2

 

[Lifeson]

Hi Fluff - Thank you for the kind welcome. The code has saved about 10 mins of run time - Thank you, Thank you.

When I run it though, it returns the number "2" in each row with number "3" indicating a duplicate and shows all records in column 13 (M) on sheet 2 as duplicates.

I'll have a fiddle though to see if I can make a change to it but any further help would be fantastic.

 

[steve the fish]

Here is what i had come up with:

Dim arr, arr2, d As Object, i As Long, tmp As String, k, a As Long

With Sheets("Sheet1")
    lr = .Cells(.Rows.Count, 13).End(xlUp).Row
    ThisWorkbook.Names.Add Name:="NewM", RefersToR1C1:=.Range(.Cells(2, 13), .Cells(lr, 13))
End With

arr = Range("NewM").Resize(Range("NewM").Rows.Count, 2)

Set d = CreateObject("scripting.dictionary")
For i = LBound(arr, 1) To UBound(arr, 1)
    tmp = Trim(arr(i, 1))
    If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1
Next

For Each k In d.Keys
    a = 1
    For i = LBound(arr, 1) To UBound(arr, 1)
        If Trim(arr(i, 1)) = k Then
            arr(i, 2) = a
            a = a + 1
        End If
    Next
Next

Range("NewM").Resize(Range("NewM").Rows.Count, 2) = arr

 

[Fluff]

It should be

Sub Lifeson()
   Dim Ary As Variant, Nary As Variant, Ky As Variant
   Dim r As Long, rr As Long
   
   With Sheets("Sheet1")
      Ary = .Range("M2", .Range("M" & Rows.Count).End(xlUp).Offset(, 1)).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 2)
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         .Item(Ary(r, 1)) = .Item(Ary(r, 1)) + 1
      Next r
      For r = 1 To UBound(Ary)
         Ary(r, 2) = .Item(Ary(r, 1))
      Next r
      Sheets("Sheet1").Range("M2").Resize(UBound(Ary), 2).Value = Ary
      For Each Ky In .Keys
         If .Item(Ky) = 1 Then
            rr = rr + 1
            Nary(rr, 1) = Ky
         End If
      Next Ky
      Sheets("Sheet2").Range("A2").Resize(rr, 2).Value = Nary
   End With
End Sub

 

[mikerickson]

How about a Name

Name: colMData
RefersTo: =Sheet1!$M$1: INDEX(Sheet1!$M:$M, MATCH("zzz",Sheet1!$M:$M, 1), 1)

That works if the data in column M is text. If it is numbers, change "zzz" to 9E+99. If its mixed, thats more complicated.

 

[Lifeson]

This is brilliant - Thank you!!! - I hate to be a pest though - It's returning the non-duplicates on sheet 2 though. I'm unsure how to change so the duplicate is returned.

 

[Lifeson]

Hi Mike.

Thanks also for the suggestion. The type of data in this field is "1234567AB01234567890ABCDEFGHIJKLMNO123.012345678901".

Not sure how I could use something like you suggest but i'll look it up.

Thanks