Re posting Please help (Macro for Special Sorting)

  • Thread starter Thread starter K
  • Start date Start date
K

K

I have file names listed in column A and B like (see below)

A B……col
Jim Boot - data.xls John Wood (Record List).xlsx
Ali Khan (data).xlsm Dean Wild - system.xls
Bob Will.xlsx Jim Boot (actuals).xlsm
John Wood.xls Kam Finch.xlsx
Ali Khan (Recorded data).xls


The special thing about file names listed in column A and B is that
the first two words in those are always the first name and last name
of the person. I am looking for a macro which should sort both these
columns lists alphabatically and also the way that same name should
come in same row. so i am looking for the result something like (see
below)


A B……col
Ali Khan (data).xlsm Ali Khan (Recorded data).xls
Bob Will.xlsx
Dean Wild - system.xls
Jim Boot - data.xls Jim Boot (actuals).xlsm
John Wood.xls John Wood (Record List).xlsx
Kam Finch.xlsx


I'll be very thankful if any friend got sultion for this kind of
sorting.
 
Try the macro below. I have assumed that your lists start in row 1 (they
will after the sort, in any case) - and that you do not have headers. If
that is not the case, change xlNo to xlYes on the sort commands, and change
For i = 1 to j to For i = 2 to j

If your lists do not start in row 1 and you want to keep it that way, change
Columns("A:A") to

Range(Range("A3"), Cells(Rows.Count,1).End(xlUp))

for data starting in row 3.

HTH,
Bernie
MS Excel MVP


Sub Macro1()
Dim S1 As String
Dim S2 As String

Dim i As Integer
Dim j As Integer

Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
Columns("B:B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo

j = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To j
S1 = Replace(Cells(i, 1).Value, ".", " ")
S1 = Left(S1, InStr(InStr(1, S1, " ") + 1, S1, " "))
S2 = Replace(Cells(i, 2).Value, ".", " ")
S2 = Left(S2, InStr(InStr(1, S2, " ") + 1, S2, " "))
If S1 < S2 Then
Cells(i, 2).Insert
j = j + 1
End If
If S1 > S2 Then
Cells(i, 1).Insert
j = j + 1
End If
Next i

End Sub



I have file names listed in column A and B like (see below)

A B……col
Jim Boot - data.xls John Wood (Record List).xlsx
Ali Khan (data).xlsm Dean Wild - system.xls
Bob Will.xlsx Jim Boot (actuals).xlsm
John Wood.xls Kam Finch.xlsx
Ali Khan (Recorded data).xls


The special thing about file names listed in column A and B is that
the first two words in those are always the first name and last name
of the person. I am looking for a macro which should sort both these
columns lists alphabatically and also the way that same name should
come in same row. so i am looking for the result something like (see
below)


A B……col
Ali Khan (data).xlsm Ali Khan (Recorded data).xls
Bob Will.xlsx
Dean Wild - system.xls
Jim Boot - data.xls Jim Boot (actuals).xlsm
John Wood.xls John Wood (Record List).xlsx
Kam Finch.xlsx


I'll be very thankful if any friend got sultion for this kind of
sorting.
 
If I were doing this operation, I would just copy and paste the list in Col
B to Col A. Then sort ascending Col A.

This merges the data and like records are next to each other.
 
The change in the upper limit doesn't work, so the whole list may not get
spaced properly. Use this code instead:

Sub Macro1()
Dim S1 As String
Dim S2 As String

Dim i As Integer
Dim j As Integer

Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
Columns("B:B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo

j = Cells(Rows.Count, 1).End(xlUp).Row * 2

For i = 1 To j
S1 = Replace(Cells(i, 1).Value, ".", " ")
S1 = Left(S1, InStr(InStr(1, S1, " ") + 1, S1, " "))
S2 = Replace(Cells(i, 2).Value, ".", " ")
S2 = Left(S2, InStr(InStr(1, S2, " ") + 1, S2, " "))
If S1 <> "" And S2 <> "" Then
If S1 < S2 Then
Cells(i, 2).Insert
End If
If S1 > S2 Then
Cells(i, 1).Insert
End If
End If
Next i

End Sub



HTH,
Bernie
MS Excel MVP
 
The change in the upper limit doesn't work, so the whole list may not get
spaced properly.  Use this code instead:

Sub Macro1()
    Dim S1 As String
    Dim S2 As String

    Dim i As Integer
    Dim j As Integer

    Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
    Columns("B:B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo

    j = Cells(Rows.Count, 1).End(xlUp).Row * 2

    For i = 1 To j
        S1 = Replace(Cells(i, 1).Value, ".", " ")
        S1 = Left(S1, InStr(InStr(1, S1, " ") + 1, S1, " "))
        S2 = Replace(Cells(i, 2).Value, ".", " ")
        S2 = Left(S2, InStr(InStr(1, S2, " ") + 1, S2, " "))
        If S1 <> "" And S2 <> "" Then
            If S1 < S2 Then
                Cells(i, 2).Insert
            End If
            If S1 > S2 Then
                Cells(i, 1).Insert
            End If
        End If
    Next i

End Sub

HTH,
Bernie
MS Excel MVP




















- Show quoted text -
Click to expand...

thanks lot Bernie
 
Back
Top