Forum Discussion
Efren_Caballes
Nov 11, 2021Copper Contributor
How to Sort Column2 Only but seperated by Space + Remove Duplicates
Hi Every One, Thus anyone have idea on how to resolved this, I have many Data to Sort, I want to Sort only Column B but it separated by Space and also I want to delete duplicate values, Is the...
- Nov 11, 2021
You may use VBA to achieve this.
In the attached, select the range with data in column B, in this case, select range B2:B22 and then run the macro called "SortAndRemoveDuplicates" on Module1 or just click the button called "Sort Data" to get the desired output.
Code:
Sub SortAndRemoveDuplicates() Dim Rng As Range Dim RngArea As Range Dim sortRng As Range Dim lr As Long Dim i As Long Dim startRow As Long If Selection.Columns.Count > 1 Or Selection.Column <> 2 Then MsgBox "Please select data in column B only and then try again...", vbExclamation Exit Sub End If On Error Resume Next Set Rng = Selection.SpecialCells(xlCellTypeConstants, 1) On Error GoTo 0 If Rng Is Nothing Then Exit Sub Application.ScreenUpdating = False startRow = Selection.Cells(1).Row lr = startRow + Selection.Rows.Count - 1 For Each RngArea In Rng.Areas Set sortRng = RngArea.Resize(, 2) sortRng.Sort key1:=sortRng.Cells(1), order1:=xlAscending, Header:=xlNo Next RngArea For i = lr To startRow Step -1 If Cells(i, 2) = Cells(i - 1, 2) Then Rows(i).Delete End If Next i Application.ScreenUpdating = True End Sub
Subodh_Tiwari_sktneer
Nov 11, 2021Silver Contributor
You may use VBA to achieve this.
In the attached, select the range with data in column B, in this case, select range B2:B22 and then run the macro called "SortAndRemoveDuplicates" on Module1 or just click the button called "Sort Data" to get the desired output.
Code:
Sub SortAndRemoveDuplicates()
Dim Rng As Range
Dim RngArea As Range
Dim sortRng As Range
Dim lr As Long
Dim i As Long
Dim startRow As Long
If Selection.Columns.Count > 1 Or Selection.Column <> 2 Then
MsgBox "Please select data in column B only and then try again...", vbExclamation
Exit Sub
End If
On Error Resume Next
Set Rng = Selection.SpecialCells(xlCellTypeConstants, 1)
On Error GoTo 0
If Rng Is Nothing Then Exit Sub
Application.ScreenUpdating = False
startRow = Selection.Cells(1).Row
lr = startRow + Selection.Rows.Count - 1
For Each RngArea In Rng.Areas
Set sortRng = RngArea.Resize(, 2)
sortRng.Sort key1:=sortRng.Cells(1), order1:=xlAscending, Header:=xlNo
Next RngArea
For i = lr To startRow Step -1
If Cells(i, 2) = Cells(i - 1, 2) Then
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
- Efren_CaballesNov 11, 2021Copper ContributorWow this works perfectly , thank you sir Subodh_Tiwari_sktneer for the VBA code,
Thank you for your Ideas and Effort.- Subodh_Tiwari_sktneerNov 11, 2021Silver Contributor
You're welcome Efren_Caballes! Glad it worked as desired.