Macro to remove duplicates

[Alex11]

Please help with the following Macro:

At the stroke of a key eg. (Cntl R)

[TABLE="width: 403"]
<colgroup><col></colgroup><tbody>[TR]
[TD]Select entire column A[/TD]
[/TR]
[TR]
[TD]Sort Column A[/TD]
[/TR]
[TR]
[TD]Remove duplicates in column A[/TD]
[/TR]
[TR]
[TD]select entire column B[/TD]
[/TR]
[TR]
[TD]Sort Column B[/TD]
[/TR]
[TR]
[TD]Remove duplicates in column B[/TD]
[/TR]
[TR]
[TD]Cut all data from B1 to last non empty cell[/TD]
[/TR]
[TR]
[TD]select first empty cell in column A[/TD]
[/TR]
[TR]
[TD]Paste data into first empty cell in column A[/TD]
[/TR]
[TR]
[TD]Delete entire column B

Thank you[/TD]
[/TR]
</tbody>[/TABLE]

 

[mole999]

have you tried macro recorder for you actions. you can use conditional formation to highlight duplicates and then filter on that colour, select down and delete, then take the filter off and do again. your output can then be tidied

 

[Alex11]

Thank you

I have tried the Macro recorder.

I am very new at this. My google searching on how to select a range up to the last empty cell and select the last empty cell led me to this attempt:

Sub Macro21()
'
' Macro21 Macro
'
' Keyboard Shortcut: Ctrl+r
'
Windows("example.xlsx").Activate
Windows("macro sort and remove.xlsm").Activate
Columns("A:A").Select
Windows("example.xlsx").Activate
Windows("macro sort and remove.xlsm").Activate
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
"A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A:A")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:= _
xlNo

Columns("B:B").Select

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
"B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("B:B")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

ActiveSheet.Range("B:B").RemoveDuplicates Columns:=1, Header:= _
xlNo

Range("B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut

Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste

Columns("B:B").Select

Selection.Delete Shift:=xlToLeft
End Sub

 

[Alex11]

The macro I attempted is unable to copy and paste only one row from column B, because I am attempting to copy from the first to last cell of data in the column. No it copies from the first cell to the last empty cell in the sheet.

How do I fix this?