Data Extract and Sort Macro Help
 

To all,

Part of my macro is showed below, it opens up a file and then searches
column A, and copies the row if it matches a certain criteria, i.e. if
the cell = FR 2096799. However sometimes the cell is FR2096799 -
without the space, or just 2096799. How can i modify it to search for
all cells in column A that 'CONTAIN' the number 2096799, not EQUAL
2096799.

Any help would be appreciated.

Kind Regards

Joseph Crabtree




Dim wbd As Workbook
Dim wsd As Worksheet
Dim wbs As Workbook
Dim wss As Worksheet


Dim row_d As Long
Dim row_s As Long


Set wbd = ThisWorkbook
Set wsd = wbd.Worksheets("DATA")


Set wbs = Workbooks.Open("C:\TESTMECH.xls", , True)
Set wss = wbs.Worksheets("compiled results")


row_d = 2
row_s = 1


Do
If UCase(wss.Cells(row_s, 3)) = "FR 2096799" Then
wss.Rows(row_s).Copy wsd.Rows(row_d)
row_d = row_d + 1
End If
row_s = row_s + 1
Loop While row_s < 65536




wbs.Close False
Set wss = Nothing
Set wbs = Nothing
Set wsd = Nothing
Set wbd = Nothing

Data Extract and Sort Macro Help
 

Use this idea. For multiples, look in the VBA help index for FINDNEXT. There
is a good example that will easily solve your problem

Sub findpartialnumberincol()
x = Columns(7).Find(222, lookat:=xlPart).Row
MsgBox x
End Sub

--
Don Guillett
SalesAid Software

"joecrabtree" wrote in message
ups.com...
To all,

Part of my macro is showed below, it opens up a file and then searches
column A, and copies the row if it matches a certain criteria, i.e. if
the cell = FR 2096799. However sometimes the cell is FR2096799 -
without the space, or just 2096799. How can i modify it to search for
all cells in column A that 'CONTAIN' the number 2096799, not EQUAL
2096799.

Any help would be appreciated.

Kind Regards

Joseph Crabtree




Dim wbd As Workbook
Dim wsd As Worksheet
Dim wbs As Workbook
Dim wss As Worksheet


Dim row_d As Long
Dim row_s As Long


Set wbd = ThisWorkbook
Set wsd = wbd.Worksheets("DATA")


Set wbs = Workbooks.Open("C:\TESTMECH.xls", , True)
Set wss = wbs.Worksheets("compiled results")


row_d = 2
row_s = 1


Do
If UCase(wss.Cells(row_s, 3)) = "FR 2096799" Then
wss.Rows(row_s).Copy wsd.Rows(row_d)
row_d = row_d + 1
End If
row_s = row_s + 1
Loop While row_s < 65536




wbs.Close False
Set wss = Nothing
Set wbs = Nothing
Set wsd = Nothing
Set wbd = Nothing