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
C:\John Owen C:\Michael Ja
C:\Michael Ja C:\Daivd Terry
C:\Ali Smith C:\John Owen
C:\Karen Seal

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
C:\John Owen C:\John Owen
C:\Michael Ja C:\Michael Ja
C:\Ali Smith
C:\Dean Smith
C:\Karen Seal

Please can any friend can help me on this

On Tue, 27 Oct 2009 09:43:34 -0700 (PDT), K
wrote:

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
C:\John Owen C:\Michael Ja
C:\Michael Ja C:\Daivd Terry
C:\Ali Smith C:\John Owen
C:\Karen Seal

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
C:\John Owen C:\John Owen
C:\Michael Ja C:\Michael Ja
C:\Ali Smith
C:\Dean Smith
C:\Karen Seal

Please can any friend can help me on this


Assuming that there are no gaps in the original tables, try the
following macro

Sub K()
amin = 1
amax = Cells(amin, "A").End(xlDown).Row
bmin = 1
bmax = Cells(bmin, "B").End(xlDown).Row
Dim result() As String
ReDim result(amax + bmax)
For b = bmin To bmax
For a = amin To amax
If Cells(b, "B") = Cells(a, "A") Then
result(a) = Cells(a, "A")
Cells(b, "B") = ""
End If
Next a
Next b
For b = bmin To bmax
If Not Cells(b, "B") = "" Then
amax = amax + 1
result(amax) = Cells(b, "B")
End If
Next b
For b = 1 To amax
Cells(b, "B") = result(b)
Next b
End Sub

Hope this helps / Lars-Åke

Hi Lars thank for replying. your macro work brilliant. i am bit
curious that how you created such a clever macro. Is it possible for
you to explain your macro to me bit in detail just for my knowledge.
many thanks

On Tue, 27 Oct 2009 14:56:13 -0700 (PDT), K
wrote:


Hi Lars thank for replying. your macro work brilliant. i am bit
curious that how you created such a clever macro. Is it possible for
you to explain your macro to me bit in detail just for my knowledge.
many thanks


The macro consists of three parts; I, II, and III

Part I: A double loop where each entry in table b is either
- copied to the result vector and then cleared from table b if it is
also found in table a
- or left in table b if there is no matching entry in table a

Part II: A single loop where the entries of table b that has not been
cleared, ie were not also found in table a is copied to the end of the
result vector. The end of the result vector is gradually increasing.

Part III: A single loop where the result vector is stored back as the
new table b which is the requested result of the macro.


The part II loop could be avoided by adding the corresponding code to
the outer loop of part I and the inner loop of part I could be exited
when a match has been found, but unless the size of the tables are not
tens of thousands of rows there is not much time to be gained by those
optimizations.

That's all there is to it. Hope that makes sence. / Lars-Åke

Thanks lot lars for the explanion. just last question. what changes
can be done in your macro if i have data like below


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)


and i need result like 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 same name file path should be in same row

On Thu, 29 Oct 2009 03:51:44 -0700 (PDT), K
wrote:


Thanks lot lars for the explanion. just last question. what changes
can be done in your macro if i have data like below


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)


and i need result like 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 same name file path should be in same row


Try changeing these two lines of code

If Cells(b, "B") = Cells(a, "A") Then
result(a) = cells(a,"A")

to these two lines

If InStr(Cells(b, "B"), Cells(a, "A")) 0 Then
result(a) = Cells(b, "B")

The exact comparison, equality, is changed to just see if the entry
in table a is the same as the start/beginning of the entry in table b.
The result is taken from table b. (In the previous version it was not
important from which table the result was taken as the table entries
were equal.)

Hope this helps / Lars-Åke

Hi lars. its not working as by adding these new lines it add rows on
the top of column B data instead of putting same name file paths in
same row. any advise

On Fri, 30 Oct 2009 01:08:49 -0700 (PDT), K
wrote:

Hi lars. its not working as by adding these new lines it add rows on
the top of column B data instead of putting same name file paths in
same row. any advise

The described problem will occur e.g. if you have leading and/or
trailing blanks in the items in column a and/or column b.

Try removing such blanks with Trim(), like this for the two lines

If InStr(Cells(b, "B"), Trim(Cells(a, "A"))) = 1 Then
result(a) = Cells(b, "B")

I repeat the full macro here for convenience

Sub K()
amin = 1
amax = Cells(amin, "A").End(xlDown).Row
bmin = 1
bmax = Cells(bmin, "B").End(xlDown).Row
Dim result() As String
ReDim result(amax + bmax)
For b = bmin To bmax
For a = amin To amax
If InStr(Trim(Cells(b, "B")), Trim(Cells(a, "A"))) = 1 Then
result(a) = Cells(b, "B")
Cells(b, "B") = ""
End If
Next a
Next b
For b = bmin To bmax
If Not Cells(b, "B") = "" Then
amax = amax + 1
result(amax) = Cells(b, "B")
End If
Next b
For b = 1 To amax
Cells(b, "B") = result(b)
Next b
End Sub

Hope this helps / Lars-Åke

sorry to be pain but your macro still not working. please see my excel
file in below link in which i explained every thing.
http://www.mediafire.com/?sharekey=6...75f6 e8ebb871

On Sat, 31 Oct 2009 04:06:41 -0700 (PDT), K
wrote:

sorry to be pain but your macro still not working. please see my excel
file in below link in which i explained every thing.
http://www.mediafire.com/?sharekey=6...75f6 e8ebb871


Well, that explains it.
You have items starting with C:\ in table a
and items starting with F:\ in table b.
As C is not the same as F, there is no match.

To skip the 3 first (non blank) characters from the comparison use the
Mid function like this:

If InStr(Mid(Trim(Cells(b, "B")), 4), Mid(Trim(Cells(a, "A")), 4)) = 1
Then

Sub K()
amin = 1
amax = Cells(amin, "A").End(xlDown).Row
bmin = 1
bmax = Cells(bmin, "B").End(xlDown).Row
Dim result() As String
ReDim result(amax + bmax)
For b = bmin To bmax
For a = amin To amax
If InStr(Mid(Trim(Cells(b, "B")), 4), Mid(Trim(Cells(a, "A")),
4)) = 1 Then
result(a) = Cells(b, "B")
Cells(b, "B") = ""
End If
Next a
Next b
For b = bmin To bmax
If Not Cells(b, "B") = "" Then
amax = amax + 1
result(amax) = Cells(b, "B")
End If
Next b
For b = 1 To amax
Cells(b, "B") = result(b)
Next b
End Sub

Hope this helps / Lars-Åke

On Sat, 31 Oct 2009 12:09:33 GMT, Lars-Åke Aspelin
wrote:

On Sat, 31 Oct 2009 04:06:41 -0700 (PDT), K
wrote:

sorry to be pain but your macro still not working. please see my excel
file in below link in which i explained every thing.
http://www.mediafire.com/?sharekey=6...75f6 e8ebb871


Well, that explains it.
You have items starting with C:\ in table a
and items starting with F:\ in table b.
As C is not the same as F, there is no match.

To skip the 3 first (non blank) characters from the comparison use the
Mid function like this:

If InStr(Mid(Trim(Cells(b, "B")), 4), Mid(Trim(Cells(a, "A")), 4)) = 1
Then

Sub K()
amin = 1
amax = Cells(amin, "A").End(xlDown).Row
bmin = 1
bmax = Cells(bmin, "B").End(xlDown).Row
Dim result() As String
ReDim result(amax + bmax)
For b = bmin To bmax
For a = amin To amax
If InStr(Mid(Trim(Cells(b, "B")), 4), Mid(Trim(Cells(a, "A")),
4)) = 1 Then
result(a) = Cells(b, "B")
Cells(b, "B") = ""
End If
Next a
Next b
For b = bmin To bmax
If Not Cells(b, "B") = "" Then
amax = amax + 1
result(amax) = Cells(b, "B")
End If
Next b
For b = 1 To amax
Cells(b, "B") = result(b)
Next b
End Sub

Hope this helps / Lars-Åke


Sorry, I didn't notice that the paths were different to.
So you have to replace the two 4 with the respective position of the
last \ in your items.
Moreover, the .xlsx part also has to be removed from the a table items
before the comparison.

The If statement is thus getting more complex, like this

If InStr(Mid(Trim(Cells(b, "B")), _
find_last_char(Trim(Cells(b, "B")), "\") + 1), _
Mid(Trim(Cells(a, "A")), find_last_char(Trim(Cells(a, "A")),
"\") + 1, _
find_last_char(Trim(Cells(a, "A")), ".") - _
find_last_char(Trim(Cells(a, "A")), "\") - 1)) = 1 Then

where I have implemented the following function to find the last
occurence of "\" and ".".

Function find_last_char(s As String, ch As String)
p = 0
For i = 1 To Len(s)
If Mid(s, i, 1) = ch Then p = i
Next i
find_last_char = p
End Function

Here is the full macro again

Sub K()
amin = 1
amax = Cells(amin, "A").End(xlDown).Row
bmin = 1
bmax = Cells(bmin, "B").End(xlDown).Row
Dim result() As String
ReDim result(amax + bmax)
For b = bmin To bmax
For a = amin To amax
If InStr(Mid(Trim(Cells(b, "B")), _
find_last_char(Trim(Cells(b, "B")), "\") + 1), _
Mid(Trim(Cells(a, "A")), find_last_char(Trim(Cells(a, "A")),
"\") + 1, _
find_last_char(Trim(Cells(a, "A")), ".") - _
find_last_char(Trim(Cells(a, "A")), "\") - 1)) = 1 Then
result(a) = Cells(b, "B")
Cells(b, "B") = ""
End If
Next a
Next b
For b = bmin To bmax
If Not Cells(b, "B") = "" Then
amax = amax + 1
result(amax) = Cells(b, "B")
End If
Next b
For b = 1 To amax
Cells(b, "B") = result(b)
Next b
End Sub

Hope this helps / Lars-Åke

there are two postings for this request. I posted this code at the
other posting

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 Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=148340

Thanks lot Lars it worked like charm. I tested it and it exactly
doing what i need. you are genious man. thanks again

Thanks lot Joel. i tried your code as well and it works superb as
well. i cant believe i got two macros to do this thing.man