Sorting Data

[K]

I got data in column A and B like see below. As you can see below I
got file paths listed in both columns.

A B……col
C:\David Terry C:\Dean Smith (MC) - 23
C:\John Owen C:\Michael Ja - 778
C:\Michael Ja C:\Daivd Terry (ds)
C:\Ali Smith C:\John Owen - x23
C:\Karen Seal - (CC)


I need macro which should sort column B list according to column A
list and results should look like as shown below


A B……col
C:\David Terry C:\David Terry (ds)
C:\John Owen C:\John Owen - x23
C:\Michael Ja C:\Michael Ja - 778
C:\Ali Smith
C:\Dean Smith (MC) - 23
C:\Karen Seal - (CC)

Basically I want it to be sorted so same names in file paths should be
in same row
Please can any friend can help me on this

 

[GerryGerry]

Sort col A then Col B
then compare B to A and where ever right(colB, len(colA)) <> colA insert a
cell in colB
I got data in column A and B like see below. As you can see below I
got file paths listed in both columns.

A B……col
C:\David Terry C:\Dean Smith (MC) - 23
C:\John Owen C:\Michael Ja - 778
C:\Michael Ja C:\Daivd Terry (ds)
C:\Ali Smith C:\John Owen - x23
C:\Karen Seal - (CC)


I need macro which should sort column B list according to column A
list and results should look like as shown below


A B……col
C:\David Terry C:\David Terry (ds)
C:\John Owen C:\John Owen - x23
C:\Michael Ja C:\Michael Ja - 778
C:\Ali Smith
C:\Dean Smith (MC) - 23
C:\Karen Seal - (CC)

Basically I want it to be sorted so same names in file paths should be
in same row
Please can any friend can help me on this

 

[Patrick Molloy]

in column C use the match function look up B in A

=MATCH(B1:A:A,False)
then sort B:C based off C

 

[GerryGerry]

Try this:-


Sub sorter()
Dim intI As Integer, strColA As String, strColB As String
Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Sort Range("A1"),
xlAscending
Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Sort Range("B1"),
xlAscending
For intI = 1 To Range("A:B").SpecialCells(xlCellTypeLastCell).Row
strColA = Trim(Cells(intI, 1).Value)
strColB = Left(Cells(intI, 2).Value, Len(strColA))
If strColB <> strColA Then
If strColB > strColA Then
Cells(intI, 2).Insert
Else
Cells(intI, 1).Insert
End If
End If
Next intI
End Sub

 

[K]

hi gerry, thanks for replying. i tried your macro but it just add row
in between
the column A and B data instead of putting same name file path in same
row. please help

 

[joel]

doing this type of exercise is usually don e better by using a find t
match the columns. Try this code. The items that matched I put an X i
column c. If you need the non matched items I can mdoify the code t
take the items without an X a move them to the bottom of the new list.


Sub SortColumns()

Set sht1 = Sheets("Sheet1")
Set Sht2 = Sheets("Sheet2")


'copy column A to sheet 2
sht1.Columns("A").Copy _
Destination:=Sht2.Columns("A")

With Sht2
'lookup column A on sht2 with column b on sht1
RowCount = 1
Do While .Range("A" & RowCount) <> ""
Folder = .Range("A" & RowCount)
Set c = sht1.Columns("B").Find(what:=Folder, _
LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
.Range("B" & RowCount) = c
'put Match into column C on sheet 1
c.Offset(0, 1) = "X"
End If

RowCount = RowCount + 1
Loop
End With


End Su

 

[K]

Hi joel thanks for replying. your macro is not working. please see my
excel file in below link in which i explained every thing.
http://www.mediafire.com/?sharekey=68e40059f0508c1b08f8df73f2072ed6e04e75f6e8ebb871

 

[joel]

Solution is real simple. I simply removed the file extension from th
filename in column A and the folder Name.

Sub SortColumns()

Set sht1 = Sheets("Sheet1")
Set Sht2 = Sheets("Sheet2")


'copy column A to sheet 2
sht1.Columns("A").Copy _
Destination:=Sht2.Columns("A")

With Sht2
'lookup column A on sht2 with column b on sht1
RowCount = 1
Do While .Range("A" & RowCount) <> ""
'remove file extension
FName = .Range("A" & RowCount)
FName = Left(FName, InStrRev(FName, ".") - 1)
'remove Folder name
FName = Mid(FName, InStrRev(FName, "\") + 1)


'remove file extension from filename
Set c = sht1.Columns("B").Find(what:=FName, _
LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
.Range("B" & RowCount) = c
'put Match into column C on sheet 1
c.Offset(0, 1).Value = "X"
End If
RowCount = RowCount + 1
Loop
End With


End Su

 

[K]

Thanks lot Joel. i tried your code as well and it works superb. you
are the best

 

[K]

Just last question joel that what kind of code i need after line

..Range("B" & RowCount) = c
in your code that i can have unmatched item get listed on the bottom
of column B of sheet2. Because at the moment your macro only putting
the matched itmes in column B of sheet2 but i need that after putting
matched items then macro should list unmatched items on the bottom.

 

[joel]

I used autofilter to get the unamtched items. I added a header row t
sheet 1 and then deleted the row. Autofilter doesn't work properly i
you don't have a header row.

Sub SortColumns()

Set Sht1 = Sheets("Sheet1")
Set Sht2 = Sheets("Sheet2")


'copy column A to sheet 2
Sht1.Columns("A").Copy _
Destination:=Sht2.Columns("A")

With Sht2
'lookup column A on sht2 with column b on sht1
RowCount = 1
Do While .Range("A" & RowCount) <> ""
'remove file extension
FName = .Range("A" & RowCount)
FName = Left(FName, InStrRev(FName, ".") - 1)
'remove Folder name
FName = Mid(FName, InStrRev(FName, "\") + 1)


Set c = Sht1.Columns("B").Find(what:=FName, _
LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
.Range("B" & RowCount) = c
'put Match into column C on sheet 1
c.Offset(0, 1).Value = "X"
End If
RowCount = RowCount + 1
Loop
NewRow = RowCount
End With

With Sht1
'get items not checked
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'Insert new row 1 so autofilter works properly
.Rows(1).Insert
.Range("C1") = "Header"
'check if there is at leat one blnak in column C
'so autofilter doesn't fail
Set FilterRange = .Range("C2:C" & LastRow)
Set c = FilterRange.Find(what:="", _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Columns("C").AutoFilter
.Columns("C").AutoFilter Field:=1, Criteria1:="="
.Range("B2:B" & LastRow).SpecialCells( _
Type:=xlCellTypeVisible).Copy _
Destination:=Sht2.Range("B" & NewRow)
'turn off autfilter
.Columns.AutoFilter
End If
'delte added header row
.Rows(1).Delete
End With

End Su

 

[K]

Thanks joel for you help