Nov 10 2021 06:50 PM - edited Nov 10 2021 06:51 PM
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 there any formula to fix this?
Please see Picture Below
Nov 10 2021 07:51 PM
Solution
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
Nov 10 2021 09:36 PM
Nov 10 2021 10:52 PM
You're welcome @Efren_Caballes! Glad it worked as desired.
Nov 10 2021 07:51 PM
Solution
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