need to combine multiple columns into 1 column and remove duplicates

[asu1057]

Hi,

I am trying to build a macro that will add multiple columns into 1 column and remove duplicates.

I ran across an issue where if a column is blank i was getting an error so i was trying to build a loop where if it is an empty cell to delete that column and move to the next step.

I am trying to paste all the columns (column B to T) into column A

I attempted the following but am still getting errors

Dim column As Long
Dim counter As Long

column = 20
Range("T1").Select

For counter = column To 2 Step -1
If IsEmpty(Cells(1, counter)) Then
Columns(counter).Delete
Else
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
Columns("A:A").Select
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:= _
xlYes
Range(Cells(1, counter)).Select
Next
End


If anyone can provide help, it would be much appreciated.

Thanks.

 

[AlphaFrog]

[color=darkblue]Sub[/color] Consolidate_Columns_BT()
    [color=darkblue]Dim[/color] col       [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]For[/color] col = 20 [color=darkblue]To[/color] 2 [color=darkblue]Step[/color] -1
        [color=darkblue]If[/color] Cells(1, col) <> "" [color=darkblue]Then[/color]
            Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Copy
            Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
            Columns(col).ClearContents
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
    [color=darkblue]Next[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]