Macro to compare then copy if string found

[Stuart]

Hi,

I have two worksheets of data. I would like excel to be able to look
in two columns which contain different characters however they should
have a string of letters and numbers which are the same.

For example sheet 1 column A cell 1 may have ABC010456A and in sheet 2
column A ot may be CDA#010456A

I would want the find function to find what they have in common and
then copy the value for the same row but column i

Please someone help.....trying to compare over a 1500 rows is very
very very time consuming.

It's much appreciated.

Thanks

Stuart

 

[sali]

is the cell position same on both sheets?
how long must be a same string to be considered the same sub-part?
is it allways the right ended part of cell?

 

[Stuart]

is the cell position same on both sheets?
how long must be a same string to be considered the same sub-part?
is it allways the right ended part of cell?

"Stuart" <[email protected]> je napisao u poruci interesnoj
grupi:[email protected]...









- Show quoted text -

Hi there

Thanks for the response.

I can place the data on the same column. It's not normally the case
but to get a solution to this then I will move the column.

The string will be more than 4 characters and I don't think it will be
more than 7.

I look forward to hearing from you,

Stuart

 

[sali]

more important is the row() position of cells.
is the position row on the coresponding cells the same?
is the number of the cells the same on both sheets?

 

[Guest]

Hi Stuart, What Sali is trying to explain is that we on this end cannot see
your worksheet, so to help us help you, you need to explain how your
worksheet is laid out. What data resides in which columns or rows, such as
part numbers in column A, description column B, etc. The when describing
what you want to do, for example, find part number xyz in column a and copy
entire row to sheet 2, row 6.
Then we on this end have an idea of what you are working with and how to
help you with your problem.

 

[Stuart]

Hi Stuart, What Sali is trying to explain is that we on this end cannot see
your worksheet, so to help us help you, you need to explain how your
worksheet is laid out. What data resides in which columns or rows, such as
part numbers in column A, description column B, etc. The when describing
what you want to do, for example, find part number xyz in column a and copy
entire row to sheet 2, row 6.
Then we on this end have an idea of what you are working with and how to
help you with your problem.











- Show quoted text -

Hi

To explain some more.......

I was hoping you could use the search function to search for the
string in a cell from one sheet and search for this string in another
sheet. The data in both sheets is not the same at all except for
these partial strings hence I thought the search/find function could
be used and if the string is found when excel looks down the rows then
copy to cope the cell on the same row from column i.

Please let me know if this exaplin more to you,

Thanks

Stuart

 

[Stuart]

Hi

To explain some more.......

I was hoping you could use the search function to search for the
string in a cell from one sheet and search for this string in another
sheet. The data in both sheets is not the same at all except for
these partial strings hence I thought the search/find function could
be used and if the string is found when excel looks down the rows then
copy to cope the cell on the same row from column i.

Please let me know if this exaplin more to you,

Thanks

Stuart- Hide quoted text -

- Show quoted text -

So no-one can actually answer this question at all? Surely someone
can help me with this........please.



*************************************************************************************************************************************

 

[sali]

So no-one can actually answer this question at all? Surely someone
can help me with this........please.

try this:
-------------------
Const maxrow1 = 200 'num rows of 1st column
Const maxrow2 = 100 'num rows of 2nd column

'scan active sheet
Sub scan1()
Dim i As Integer, j As Integer, k As Integer
With ActiveSheet
For i = 1 To maxrow2
k = 3
For j = 1 To maxrow1
If match1(.Cells(j, 1).Value, .Cells(i, 2).Value) Then
.Cells(i, k).Value = .Cells(j, 1).Value
k = k + 1
End If
Next
Next
End With
End Sub

'compare rightmost chars, try:7, abort after:4
Function match1(s1 As String, s2 As String) As Boolean
Dim i As Integer
For i = 7 To 4 Step -1
If InStrRev(s1, Right(s2, i)) > 0 Then
match1 = True
Exit Function
End If
Next
End Function
-------------------

it works with two columns:
1st contains basic data
2nd contains data to be compared with 1st column
if match is found in 1st column, that value is written into 3rd column
if anotjer match is found in 1st column, it is written into 4rd column, and
so on
match is with max 7 and at least rightmost chars
you have to define const maxrow1 and maxrow2 how much actual data you have

on the end, column 3rd and toward right will contain values from 1st found
in current row of 2nd column

of course, insert vba module and copy this code inside, and call it from
sheet with f8 key

this is quite basic framework, you may extent it if found so.

let me know if something unclear

 

[Stuart]

try this:
-------------------
Const maxrow1 = 200 'num rows of 1st column
Const maxrow2 = 100 'num rows of 2nd column

'scan active sheet
Sub scan1()
Dim i As Integer, j As Integer, k As Integer
With ActiveSheet
For i = 1 To maxrow2
k = 3
For j = 1 To maxrow1
If match1(.Cells(j, 1).Value, .Cells(i, 2).Value) Then
.Cells(i, k).Value = .Cells(j, 1).Value
k = k + 1
End If
Next
Next
End With
End Sub

'compare rightmost chars, try:7, abort after:4
Function match1(s1 As String, s2 As String) As Boolean
Dim i As Integer
For i = 7 To 4 Step -1
If InStrRev(s1, Right(s2, i)) > 0 Then
match1 = True
Exit Function
End If
Next
End Function
-------------------

it works with two columns:
1st contains basic data
2nd contains data to be compared with 1st column
if match is found in 1st column, that value is written into 3rd column
if anotjer match is found in 1st column, it is written into 4rd column, and
so on
match is with max 7 and at least rightmost chars
you have to define const maxrow1 and maxrow2 how much actual data you have

on the end, column 3rd and toward right will contain values from 1st found
in current row of 2nd column

of course, insert vba module and copy this code inside, and call it from
sheet with f8 key

this is quite basic framework, you may extent it if found so.

let me know if something unclear

Hi Sali

Thanks for your response.

How do I define the sheets and columns where the data to be compared
is???? Remember the data is on two sheets. Is possible if it could
copy and paste the values that match and also some over cells from
both sheets in a new sheet this would be alot easier.

Please let me know,

Thanks

Stuart.

 

[sali]

Thanks for your response.

How do I define the sheets and columns where the data to be compared
is???? Remember the data is on two sheets. Is possible if it could
copy and paste the values that match and also some over cells from
both sheets in a new sheet this would be alot easier.

Please let me know,

Thanks

Stuart.

yes, iti is made simple and intended you to manualy prepare data sheet, so
the code may be kept as simple as possible.
so, as i understood, you have two columns worth of data on two sheets.
copy them on new sheet, not neccessary in the same workbook, it may be new
workbook.
column copy having data started from row 1 [so no title header rows]
one of columns copy to new column 1 ["A"], the second column as column 2
["C"]
the program searches strings column 2 if they are [and where] contained in
column 1
you *must* adjust two constants at the begining of macro to reflect the
actual row count column 1 and column 2 occupy

the macro analyses worksheet which is active at the moment of program start.
it works on the same data you are looking on.
so, just hit F8, and enjoy

 

[Stuart]

"Stuart" <[email protected]> je napisao u poruci interesnoj
grupi:[email protected]...

Thanks for your response.

How do I define the sheets and columns where the data to be compared
is???? Remember the data is on two sheets. Is possible if it could
copy and paste the values that match and also some over cells from
both sheets in a new sheet this would be alot easier.

Please let me know,

Stuart.

yes, iti is made simple and intended you to manualy prepare data sheet, so
the code may be kept as simple as possible.
so, as i understood, you have two columns worth of data on two sheets.
copy them on new sheet, not neccessary in the same workbook, it may be new
workbook.
column copy having data started from row 1 [so no title header rows]
one of columns copy to new column 1 ["A"], the second column as column 2
["C"]
the program searches strings column 2 if they are [and where] contained in
column 1
you *must* adjust two constants at the begining of macro to reflect the
actual row count column 1 and column 2 occupy

the macro analyses worksheet which is active at the moment of program start.
it works on the same data you are looking on.
so, just hit F8, and enjoy- Hide quoted text -

- Show quoted text -

Hi Sali

There may be some confusion

I have two sheets full of data in each column.

Copying one column and comparing is not what I want exactly.

I want the macro to look at one sheet and then look down the other
sheets columns to check if the string is contained within that
column. The the string from the other sheet is a contained then for
the macro to extract a cell in column K of the same row that had a
match and then copy it to the end of another sheet.

Does this make sense?

 

[sali]

There may be some confusion

I have two sheets full of data in each column.

Copying one column and comparing is not what I want exactly.

I want the macro to look at one sheet and then look down the other
sheets columns to check if the string is contained within that
column. The the string from the other sheet is a contained then for
the macro to extract a cell in column K of the same row that had a
match and then copy it to the end of another sheet.

Does this make sense?

as usualy the problem is in undersztanding between peoples!
to write a macro, you need 5 minutes, to understand a problem, you need 5
hours!
just to make it clear:

how many much columns "down the other sheets columns"?

to "copy it to the end of another sheet" does it mean append to the bottom
of the leftmost column at the "third" sheet?

 

[Stuart]

"Stuart" <[email protected]> je napisao u poruci interesnoj
grupi:[email protected]...











as usualy the problem is in undersztanding between peoples!
to write a macro, you need 5 minutes, to understand a problem, you need 5
hours!
just to make it clear:

how many much columns "down the other sheets columns"?

to "copy it to the end of another sheet" does it mean append to the bottom
of the leftmost column at the "third" sheet?- Hide quoted text -

- Show quoted text -

Hi

This will make it slightly easier to comprehend.

The macro should:

Look in sheet 2 column A and then search for the string in sheet 1
column A. If found then insert a row and copy the row from sheet 2
into sheet 1.

I will make sure the columns match back. This should allow me to work
the way I want.

Thanks

 

[acampbell]

So no-one can actually answer this question at all? Surely someone
can help me with this........please.

***************************************************************************­**********************************************************- Hide quoted text -

- Show quoted text -

Stuart,

I got your email. JLGwhiz and Sali are correct. Rather than propose
which solution you would like to see, It is best that you post some
sample data in this case and explain, clearly, what you would like to
happen. Let those who may help come up with solutions. Email a sample
spreadsheet and/or post some sample data back to this thread.

Alan

 

[Stuart]

Stuart,

I got your email. JLGwhiz and Sali are correct. Rather than propose
which solution you would like to see, It is best that you post some
sample data in this case and explain, clearly, what you would like to
happen. Let those who may help come up with solutions. Email a sample
spreadsheet and/or post some sample data back to this thread.

Alan- Hide quoted text -

- Show quoted text -

Hey Alan

Thanks for getting back to me,

I dont know how to email the post with a sample file of what I want to
see.

Can you help me out with this?

Thanks

Stuart

 

[acampbell]

Hey Alan

Thanks for getting back to me,

I dont know how to email the post with a sample file of what I want to
see.

Can you help me out with this?

Thanks

Stuart- Hide quoted text -

- Show quoted text -

Stuart,

Email the spreadsheet directly to me or post a sample of the current &
expected data layout here so others may help out. Somebody may have a
ready-made solution once we get clarificaton on your needs.

Alan

 

[acampbell]

Hey Alan

Thanks for getting back to me,

I dont know how to email the post with a sample file of what I want to
see.

Can you help me out with this?

Thanks

Stuart- Hide quoted text -

- Show quoted text -

Stuart,

Based on your sample data provided, the code below should provide what
you need. The "fNumOnly" function was a modification of an earlier
post by Shockley. This strips out the alpha characters and uses the
results in the find operation of the sub. I left the output on sheet
2 rather than a new sheet.

Alan

Sheet1:

Column1 Column2 Column3 Column4
ABC10125 1 20
40 60
ABC11126 1 20
40 60
ABC20140 1 20
40 60
ABC20141 1 20
40 60
ABC20142 1 20
40 60

Sheet 2:

Column1 Column2 Column3 Column4
BUC10125 1 20
40 60
PDB11126 1 20
40 60
ZYT20140 1 20
40 60
IOP20141 1 20
40 60
IER20142 1 20
40 60


Output (Combined):

Col1 Col2 Col3 Col4
Col1 Col2 Col3 Col4
BUC10125 ABC10125 1
20 40 60 1 20 40 60
PDB11126 ABC10125 1
20 40 60 1 20 40 60
ZYT20140 ABC10125 1
20 40 60 1 20 40 60
IOP20141 ABC10125 1
20 40 60 1 20 40 60
IER20142 ABC10125 1
20 40 60 1 20 40 60



Sub Data_Match()
Dim Endrow As Integer
Dim Endrow2 As Integer
Dim lkfor As Variant
With Sheets(1)
Endrow = Cells(Rows.Count, 1).End(xlUp).Row
.Names.Add Name:="rFind", _
RefersTo:=.Range(.Cells(2, 1), _
.Cells(Endrow, 1))
End With
With Sheets(2)
Endrow2 = Cells(Rows.Count, 1).End(xlUp).Row
.Cells(1, 2).EntireColumn.Insert
.Range("C1").Resize(1, 4).Copy _
Destination:=Range("C1").Offset(0, 4)
End With
For r = 2 To Endrow2
sresult = fNumOnly(Cells(r, 1).Value)
Set lkfor = Sheets(1).Range("rFind").Find(sresult,
LookIn:=xlValues, _
lookat:=xlPart)
If lkfor Is Nothing Then
GoTo continue:
Else
Cells(r, 1).Offset(0, 1).Value = lkfor
Sheets(1).Range((lkfor.Address)).Offset(0, 1).Resize(1,
4).Copy _
Destination:=Cells(r, 1).Offset(0, 6)
End If
continue:
Next r
End Sub

Function fNumOnly(sTest) 'Shockley
For i = 1 To Len(sTest)
s = Mid(sTest, i, 1)
If s Like "#" Then _
s1 = s1 & s
Next i
fNumOnly = s1
End Function

 

[acampbell]

Stuart,

Based on your sample data provided, the code below should provide what
you need. The "fNumOnly" function was a modification of an earlier
post by Shockley. This strips out the alpha characters and uses the
results in the find operation of the sub. I left the output on sheet
2 rather than a new sheet.

Alan

Sheet1:

Column1 Column2 Column3 Column4
ABC10125 1 20
40 60
ABC11126 1 20
40 60
ABC20140 1 20
40 60
ABC20141 1 20
40 60
ABC20142 1 20
40 60

Sheet 2:

Column1 Column2 Column3 Column4
BUC10125 1 20
40 60
PDB11126 1 20
40 60
ZYT20140 1 20
40 60
IOP20141 1 20
40 60
IER20142 1 20
40 60

Output (Combined):

Col1 Col2 Col3 Col4
Col1 Col2 Col3 Col4
BUC10125 ABC10125 1
20 40 60 1 20 40 60
PDB11126 ABC10125 1
20 40 60 1 20 40 60
ZYT20140 ABC10125 1
20 40 60 1 20 40 60
IOP20141 ABC10125 1
20 40 60 1 20 40 60
IER20142 ABC10125 1
20 40 60 1 20 40 60

Sub Data_Match()
Dim Endrow As Integer
Dim Endrow2 As Integer
Dim lkfor As Variant
With Sheets(1)
Endrow = Cells(Rows.Count, 1).End(xlUp).Row
.Names.Add Name:="rFind", _
RefersTo:=.Range(.Cells(2, 1), _
.Cells(Endrow, 1))
End With
With Sheets(2)
Endrow2 = Cells(Rows.Count, 1).End(xlUp).Row
.Cells(1, 2).EntireColumn.Insert
.Range("C1").Resize(1, 4).Copy _
Destination:=Range("C1").Offset(0, 4)
End With
For r = 2 To Endrow2
sresult = fNumOnly(Cells(r, 1).Value)
Set lkfor = Sheets(1).Range("rFind").Find(sresult,
LookIn:=xlValues, _
lookat:=xlPart)
If lkfor Is Nothing Then
GoTo continue:
Else
Cells(r, 1).Offset(0, 1).Value = lkfor
Sheets(1).Range((lkfor.Address)).Offset(0, 1).Resize(1,
4).Copy _
Destination:=Cells(r, 1).Offset(0, 6)
End If
continue:
Next r
End Sub

Function fNumOnly(sTest) 'Shockley
For i = 1 To Len(sTest)
s = Mid(sTest, i, 1)
If s Like "#" Then _
s1 = s1 & s
Next i
fNumOnly = s1
End Function- Hide quoted text -

- Show quoted text -

Stuart,

Revised code based for working with variable data ranges.

Alan

Sub Data_Match()
Dim Endrow As Long
Dim Endrow2 As Long
Dim MyCol As Integer
Dim lkfor As Variant
With Sheets(1)
MyCol = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Offset(0,
1).Column
Endrow = Cells(Rows.Count, 1).End(xlUp).Row
.Names.Add Name:="rFind", _
RefersTo:=.Range(.Cells(2, 1), _
.Cells(Endrow, 1))
End With
With Sheets(2)
Endrow2 = Cells(Rows.Count, 1).End(xlUp).Row
.Cells(1, 2).EntireColumn.Insert
.Range("C1").Resize(1, MyCol - 1).Copy _
Destination:=Range("C1").Offset(0, 4)
End With
For r = 2 To Endrow2
sresult = fNumOnly(Cells(r, 1).Value)
Set lkfor = Sheets(1).Range("rFind").Find(sresult,
LookIn:=xlValues, _
lookat:=xlPart)
If lkfor Is Nothing Then
GoTo continue:
Else
MyCol = Sheets(1).Cells(r,
Columns.Count).End(xlToLeft).Offset(0, 1).Column
Cells(r, 1).Offset(0, 1).Value = lkfor
Sheets(1).Range((lkfor.Address)).Offset(0, 1).Resize(1, MyCol
- 1).Copy _
Destination:=Cells(r,
Columns.Count).End(xlToLeft).Offset(0, 1)
End If
continue:
Next r
End Sub


Function fNumOnly(sTest) 'Shockley
For i = 1 To Len(sTest)
s = Mid(sTest, i, 1)
If s Like "#" Then _
s1 = s1 & s
Next i
fNumOnly = s1
End Function
Sub test()
With ActiveSheet
MsgBox Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column
End With
End Sub

 

[acampbell]

Hey Alan

Thanks for getting back to me,

I dont know how to email the post with a sample file of what I want to
see.

Can you help me out with this?

Thanks

Stuart- Hide quoted text -

- Show quoted text -

Stuart, Revised code that will work on varying data ranges.

Alan

Sub Data_Match()
Dim Endrow As Long
Dim Endrow2 As Long
Dim MyCol As Integer
Dim lkfor As Variant
With Sheets(1)
MyCol = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Offset(0,
1).Column
Endrow = Cells(Rows.Count, 1).End(xlUp).Row
.Names.Add Name:="rFind", _
RefersTo:=.Range(.Cells(2, 1), _
.Cells(Endrow, 1))
End With
With Sheets(2)
Endrow2 = Cells(Rows.Count, 1).End(xlUp).Row
.Cells(1, 2).EntireColumn.Insert
.Range("C1").Resize(1, MyCol - 1).Copy _
Destination:=Range("C1").Offset(0, 4)
End With
For r = 2 To Endrow2
sresult = fNumOnly(Cells(r, 1).Value)
Set lkfor = Sheets(1).Range("rFind").Find(sresult,
LookIn:=xlValues, _
lookat:=xlPart)
If lkfor Is Nothing Then
GoTo continue:
Else
MyCol = Sheets(1).Cells(r,
Columns.Count).End(xlToLeft).Offset(0, 1).Column
Cells(r, 1).Offset(0, 1).Value = lkfor
Sheets(1).Range((lkfor.Address)).Offset(0, 1).Resize(1, MyCol
- 1).Copy _
Destination:=Cells(r,
Columns.Count).End(xlToLeft).Offset(0, 1)
End If
continue:
Next r
End Sub


Function fNumOnly(sTest) 'Shockley
For i = 1 To Len(sTest)
s = Mid(sTest, i, 1)
If s Like "#" Then _
s1 = s1 & s
Next i
fNumOnly = s1
End Function
Sub test()
With ActiveSheet
MsgBox Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column
End With
End Sub