View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
Lars-Åke Aspelin[_2_] Lars-Åke Aspelin[_2_] is offline
external usenet poster
 
Posts: 913
Default Sorting a list according to other list

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