1

As part of a larger macro, I'm trying to copy a range from one sheet to another sheet, remove the duplicates, and set the remaining unique values as a range. I've written the below that works in principal, but after removing duplicates and setting the remaining cells as a range, the last cell in the range is always a blank one. How can I ignore this blank cell, so my range is on the unique values?

lr = Data.Cells(Rows.Count, "B").End(xlUp).Row
Data.Range("B5:B" & lr).Copy Sheets("Index").Range("B1")
Sheets("Index").Range("B1:B10000").Copy
Sheets("Index").Range("B1").PasteSpecial xlPasteValues
Sheets("Index").Range("B1:B10000").RemoveDuplicates Columns:=1, Header:=xlNo
Application.CutCopyMode = False
lr = Sheets("Index").Cells(Rows.Count, "B").End(xlUp).Row
Set MCH = Sheets("Index").Range("B1:B" & lr)

FYI the reason I'm copying paste values with the range is because its copying a 'helper' column that combines 2 names, and my macro didn't work without doing that. If there is a more efficient way, I'm all ears.

user5059623
  • 13
  • 3
Erik Rasmussen
  • 321
  • 2
  • 9
  • 22

2 Answers2

2

As Gary's Student has noted there will be a blank row in the hard-coded range "B1:B10000".

Try using your last row logic again to adjust the 10000 - I think as you are pasting from B5 you can adjust from lr to (lr+4): 

lr = Data.Cells(Rows.Count, "B").End(Excel.xlUp).Row
Data.Range("B5:B" & lr).Copy Sheets("Index").Range("B1")
Sheets("Index").Range("B1:B" & (lr+4)).Copy
Sheets("Index").Range("B1").PasteSpecial Excel.xlPasteValues
Sheets("Index").Range("B1:B" & (lr+4)).RemoveDuplicates Columns:=1, Header:=Excel.xlNo
Excel.Application.CutCopyMode = False
lr = Sheets("Index").Cells(Rows.Count, "B").End(Excel.xlUp).Row
Set MCH = Sheets("Index").Range("B1:B" & lr)

A very different, but much prettier approach, is to use an array and collection like this:

Sub unique()
  Dim arr As New Collection, a
  Dim aFirstArray() As Variant
  Dim i As Long

  Dim Data as Excel.worksheet
  Set Data = Thisworkbook.sheets("Data")

  lr = Data.Cells(Rows.Count, 2).End(Excel.xlUp).Row
  aFirstArray() = Data.Range("B5:B" & lr)

  On Error Resume Next
  For Each a In aFirstArray
     arr.Add a, a
  Next

  For i = 1 To arr.Count
     Sheets("Index").Cells(i, 2) = arr(i)
  Next

End Sub

Arrays are very fast - I'd imagine this is also quicker.

I wish this second scipt was my original piece of code but it is an adaptation. Reference:
vba: get unique values from array

Community
  • 1
  • 1
whytheq
  • 34,466
  • 65
  • 172
  • 267
  • Much more elegant, thank you for your help! I did notice that I had to replace aFirstArray() with aFirstArray to make it work, but much faster after that. – Erik Rasmussen Jun 30 '15 at 09:01
0

If there are cells in a column that contain Nulls before duplicates are removed; then at least one cell containing a Null will be in the column after duplicates are removed.

You can remove the Null afterwards.

Gary's Student
  • 95,722
  • 10
  • 59
  • 99