VBA inquiry to remove duplicates

[rn119]

I have a column that has duplicate values that I would like to remove. If I reference the column (Column N in this case) I can get this to work with the following syntax.

Private Sub CommandButton1_Click()


Dim firstvalue As String
Dim lastvalue As String
Dim arraystr() As String
Dim x As Long
Dim k As Long
Dim cell As Range
Dim rw As Long


Application.ScreenUpdating = False

For Each cell In Sheets("Sheet1").Range("N1:N" & Cells(Rows.Count, 1).End(xlUp).Row)
Erase arraystr ' erase array
lastvalue = "" ' erase final value"
firstvalue = cell.Value
On Error Resume Next

arraystr = Split(firstvalue, ",")


For rw = 0 To UBound(arraystr)

For k = rw + 1 To UBound(arraystr)
If Trim(arraystr(k)) = Trim(arraystr(rw)) Then
arraystr(k) = ""
End If
Next k
Next rw


For x = 0 To UBound(arraystr)
If arraystr(x) <> "" Then

lastvalue = lastvalue & Trim(arraystr(x)) & ", "
End If
Next x

lastvalue = Trim(lastvalue)
lastvalue = Left(lastvalue, Len(lastvalue) - 1)


cell.Offset(0, 0).Value = lastvalue
Next cell


Columns("N:N").Select
Selection.EntireColumn.AutoFit


Application.ScreenUpdating = True
End Sub

I prefer to do it by the column name (let's call it 'Invoice Description') since the columns can shift over time. Any help?

 

[Fluff]

Try

Private Sub CommandButton1_Click()

Dim Clmn As Long
Dim firstvalue As String
Dim lastvalue As String
Dim arraystr() As String
Dim x As Long
Dim k As Long
Dim cell As Range
Dim rw As Long


Application.ScreenUpdating = False
Clmn = Range("1:1").find("Invoice Description", , , xlWhole, , , False, , False).Column
For Each cell In Sheets("Sheet1").Range(Cells(1, Clmn), Cells(Rows.Count, Clmn).End(xlUp))
Erase arraystr ' erase array
lastvalue = "" ' erase final value"
firstvalue = cell.Value
On Error Resume Next

arraystr = Split(firstvalue, ",")


For rw = 0 To UBound(arraystr)

For k = rw + 1 To UBound(arraystr)
If Trim(arraystr(k)) = Trim(arraystr(rw)) Then
arraystr(k) = ""
End If
Next k
Next rw


For x = 0 To UBound(arraystr)
If arraystr(x) <> "" Then

lastvalue = lastvalue & Trim(arraystr(x)) & ", "
End If
Next x

lastvalue = Trim(lastvalue)
lastvalue = Left(lastvalue, Len(lastvalue) - 1)


cell.Offset(0, 0).Value = lastvalue
Next cell


Columns(Clmn).Select
Selection.EntireColumn.AutoFit


Application.ScreenUpdating = True
End Sub

 

[rn119]

Sweet that worked. Thank you Fluff.

 

[Fluff]

You're welcome