Macro for Special Sorting
 

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.

Macro for Special Sorting
 

depending on the size of your spread sheet code to do this would run quite a
long time.

For the most efficent method that i know of try inserting a new column to
the left of the two columns holding these file names.

now using the new column set a range variable to be from the first row of
data to the last row of data.

then on that range set the .formula = "=IF(b2c2,b2,c2)" for ascending or
"=IF(b2<c2,b2,c2)" for descending

sort by the whole table by the new colum, and delete the column after the
sort...

FYI: excel 03's sort is non-stable, meaning if two rows have the same value
they can endup in any order...

"K" wrote:

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

Macro for Special Sorting
 

Hi K,
What you have is a two file (columns A and B) matching program to write
where a match between A and B is not guaranteed.

Is the following true?
names start in row 1 in a column and when the cell in the column is null
the "end" of your file has been reached ?

There is alway at least 1 space between the first name and the last ?

there are only two names, first and last.

At the end of the last name is either a space, or a "." ?

the text between the last letter of the last name and the "." can be
treated as one block of text ?

If yes to all of the above, I'll work up a skeleton macro which you
should be able to finish.

Neal Z.

--
Neal Z


"K" wrote:

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

Macro for Special Sorting
 

Hi K,
There's more code than you might think.

Your problem was almost the same as a macro I had already written.

Good luck. It should run fine.


Sub MatchNamesAndWrite()

Dim INws As Worksheet 'file A and B raw name cells
Dim OUTws As Worksheet 'sheet where you want results written

Dim AyRowA As Long
Dim AyRowB As Long
Dim Col As Long
Dim CountA As Long 'how many A names
Dim CountB As Long 'how many B names
Dim FileAStartRow As Long 'where does file A start in INws
Dim FileAcol As Long 'column number of file A
Dim FileBStartRow As Long 'where does file B start in INws
Dim FileBcol As Long 'column number of file B
Dim Ix As Long
Dim Jx As Long
Dim MatchNum As Long
Dim Position As Long
Dim Row As Long
Dim Ubnd As Long

Dim FileAay As Variant 'array to hold A names, will be 2 dimensions
Dim KeyA As String
Dim FileBay As Variant 'array to hold B names, will be 2 dimensions
Dim KeyB As String

Dim SortAy As Variant
Dim SortHoldAy As Variant
Dim sHoldAy() As String 'work array to split name/file data
Dim sMisc As String 'work area variable
Dim FirstName As String
Dim LastName As String


Set INws = Sheets("Mar15") 'or ActiveSheet or ???
FileAStartRow = 1 ' change if value is different
FileAcol = 1 ' change column if different
FileBStartRow = 1 'change if value is different
FileBcol = 2 'change if column is different


With INws
' count the names in File A, null cell ends the count.
' 1000 for sure the end of A names row
For Row = FileAStartRow To 1000
If .Cells(Row, FileAcol).Value < "" Then
CountA = CountA + 1
Else
Exit For 'end of A names
End If
Next Row

'do the same for file B
' 1000 for sure the end of B names row
For Row = FileBStartRow To 1000
If .Cells(Row, FileBcol).Value < "" Then
CountB = CountB + 1
Else
Exit For 'end of B names
End If
Next Row
End With

ReDim SortHoldAy(1, 5) 'for sorting later
'there are 5 columns in each array row to hold data
'In this macro, only array columns 1 and 2 are used.
If CountA 0 Then ReDim FileAay(1 To CountA, 5)
If CountB 0 Then ReDim FileBay(1 To CountB, 5)


'Load File A with data, compose the sort key from
'the column A cell contents
With INws
AyRowA = 1 'first array row
For Row = FileAStartRow To FileAStartRow + CountA - 1
sMisc = .Cells(Row, FileAcol).Value 'cell as is into variable
sMisc = Trim(sMisc) 'remove any leading or trailing spaces

Do While InStr(sMisc, " ") 0
sMisc = Replace(sMisc, " ", " ")
'make sure only 1 space between words
Loop

FileAay(AyRowA, 1) = sMisc 'adjusted cell value into array

'isolate the first name and last name
sHoldAy = Split(sMisc, " ")
'get items delimited by a space between them
Ubnd = UBound(sHoldAy) 'how many words, base 0 array

FirstName = sHoldAy(0)
If Ubnd < 1 Then
MsgBox Row & " row has no spaces, fix column A"
Exit Sub
End If

If InStr(sHoldAy(1), ".") 0 Then
'last name has no space after it, but has a "."
'get name by using the position of the .
Position = InStr(sHoldAy(1), ".")
If Position < 1 Then
MsgBox "No space and no . after name in row " _
& Row & " , Fix column A"
Exit Sub
End If

LastName = Left(sHoldAy(1), Position - 1)
Else
LastName = sHoldAy(1)
End If
'make sort key of last,first and store in array column 2
sMisc = LastName & "," & FirstName
FileAay(AyRowA, 2) = sMisc

AyRowA = AyRowA + 1
Next Row

'Same thing , create file B
AyRowB = 1 'first array row
For Row = FileBStartRow To FileBStartRow + CountB - 1
sMisc = .Cells(Row, FileBcol).Value 'cell as is into variable
sMisc = Trim(sMisc) 'remove any leading or trailing spaces

Do While InStr(sMisc, " ") 0
sMisc = Replace(sMisc, " ", " ")
'make sure only 1 space between words
Loop

FileBay(AyRowB, 1) = sMisc 'adjusted cell value into array

'isolate the first name and last name
sHoldAy = Split(sMisc, " ")
'get items delimited by a space between them
Ubnd = UBound(sHoldAy) 'how many words, base 0 array

FirstName = sHoldAy(0)
If Ubnd < 1 Then
MsgBox Row & " row has no spaces, fix column B"
Exit Sub
End If

If InStr(sHoldAy(1), ".") 0 Then
'last name has no space after it, but has a "."
'get name by using the position of the .
Position = InStr(sHoldAy(1), ".")
If Position < 1 Then
MsgBox "No space and no . after name in row " _
& Row & " , Fix column B"
Exit Sub
End If

LastName = Left(sHoldAy(1), Position - 1)
Else
LastName = sHoldAy(1)
End If
'make sort key of last,first and store in array column 2
sMisc = LastName & "," & FirstName
FileBay(AyRowB, 2) = sMisc

AyRowB = AyRowB + 1
Next Row
End With 'InWs


If CountA 1 Then 'sort only with 2 or more items
SortAy = FileAay
GoSub Sort
FileAay = SortAy
End If
If CountB 1 Then
SortAy = FileBay
GoSub Sort
FileBay = SortAy
End If

Set OUTws = INws 'you can write to a different sheet, as desired.

FileAcol = 4 'column D change #'s for a different location
FileBcol = 6 'column F

With OUTws
'much quicker when writing to sheets
Application.ScreenUpdating = False

'sheet output start row, change #'s for a different location
Row = 1


If CountA 0 And CountB 0 Then
'Now, we can match the two sorted files that have a common
'key. Do not write over the input.
'This matching model assumes there may be more than one array
'row with the same key; LastName,FirstName. You did not say
'anything about that in your problem statement.
AyRowA = 1
KeyA = FileAay(AyRowA, 2) 'last,first
AyRowB = 1
KeyB = FileBay(AyRowB, 2) 'last,first

'end of file marker high values
Do While KeyA < "zzzzzz" And KeyB < "zzzzzz"

MatchNum = StrComp(KeyA, KeyB, vbTextCompare)

If MatchNum = 0 Then
'have a match, write both, add 1 to both array rows
.Cells(Row, FileAcol).Value = FileAay(AyRowA, 1) 'column A text
.Cells(Row, FileBcol).Value = FileBay(AyRowB, 1) 'column B text
AyRowA = AyRowA + 1 'new A file row
AyRowB = AyRowB + 1 'new B file row

ElseIf MatchNum = 1 Then 'file A higher
'write and read file B
.Cells(Row, FileBcol).Value = FileBay(AyRowB, 1)
AyRowB = AyRowB + 1

ElseIf MatchNum = -1 Then 'file A lower
'write and read file A
.Cells(Row, FileAcol).Value = FileAay(AyRowA, 1)
AyRowA = AyRowA + 1
End If

If AyRowA <= CountA Then
KeyA = FileAay(AyRowA, 2)
Else
KeyA = "zzzzzz"
End If

If AyRowB <= CountB Then
KeyB = FileBay(AyRowB, 2)
Else
KeyB = "zzzzzz"
End If

Row = Row + 1 'new sheet row
Loop

ElseIf CountA 0 Then
'no file B names, write only file A
For AyRowA = 1 To CountA
.Cells(Row, FileAcol).Value = FileAay(AyRowA, 1)
Row = Row + 1 'worksheet row
Next AyRowA

Else
'no file A names, write only file B
For AyRowB = 1 To CountB
.Cells(Row, FileBcol).Value = FileBay(AyRowB, 1)
Row = Row + 1 'worksheet row
Next AyRowB
End If
End With

Application.ScreenUpdating = True
Exit Sub


Sort: 'Sort file, ascending, on the key in array column 2.
'This is a bubble sort, "in place".
'It will do about 500 array rows in 1 second.
For Ix = LBound(SortAy, 1) To (UBound(SortAy, 1) - 1)
For Jx = (Ix + 1) To UBound(SortAy, 1)

If StrComp(SortAy(Ix, 2), SortAy(Jx, 2), vbTextCompare) = 1 Then
'the lower file row has a greater value, so exchange the rows
For Col = LBound(SortAy, 2) To UBound(SortAy, 2)
SortHoldAy(1, Col) = SortAy(Ix, Col) 'store data this array row
SortAy(Ix, Col) = SortAy(Jx, Col) 'exchange
SortAy(Jx, Col) = SortHoldAy(1, Col) 'exchange
Next Col
End If
Next Jx
Next Ix
Return
End Sub
--
Neal Z


"K" wrote:

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

Macro for Special Sorting
 

Hi Z42,
I don't understand why you say the code would run a long time.

I put the code into K's posting. I had a macro that was very similar and
modified it.

With about 500 rows of test data, it ran in under 3 seconds. I don't
think that's a long time.

All the best,
N

--
Neal Z


"IdiotZ42" wrote:

depending on the size of your spread sheet code to do this would run quite a
long time.

For the most efficent method that i know of try inserting a new column to
the left of the two columns holding these file names.

now using the new column set a range variable to be from the first row of
data to the last row of data.

then on that range set the .formula = "=IF(b2c2,b2,c2)" for ascending or
"=IF(b2<c2,b2,c2)" for descending

sort by the whole table by the new colum, and delete the column after the
sort...

FYI: excel 03's sort is non-stable, meaning if two rows have the same value
they can endup in any order...

"K" wrote:

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