Re posting Please help (Macro for Special Sorting)

[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.

 

[Bernie Deitrick]

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.

 

[Dennis Tucker]

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.

 

[Bernie Deitrick]

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

 

[K]

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 -

thanks lot Bernie