Find string match in column then paste adjacent cell

tswood · Jun 24th 2016

Hello,

I am trying to write a code that will do the following:

- Search column A in sheet1 for a match to C1 in sheet2
- if there is a match in column A then copy the value in column F of the corresponding row
- Paste in E14 of sheet2

Here is the code I have so far but I feel like I am way off.

Code

Dim i As Long
sheet1 = Worksheets("Budget")
sheet2 = Worksheets("Summary")
wsSource.Activate
For i = 1 To Range("A:A").Row
If sheet1.Cells(i, 2).Value = sheet2.Cells(1, 3).Value Then
Cells(i, 6).Copy Destination:=sheet2.Cells(14, 5)
End If
Next i

Display More

Any assistance would be greatly appreciated.

Many thanks

vcoolio · Jun 24th 2016

Re: Find string match in column then paste adjacent cell

Hello TSWood,

If I have understood your post, I believe that the following code may do the task for you:-

Code

Sub FindIt()
Application.ScreenUpdating = False
Dim lRow As Long
Dim fValue As Range
lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Sheet1.Range("A1:A" & lRow)
Set fValue = Sheet2.Columns("C:C").Find(cell.Value)
If fValue Is Nothing Then GoTo NextCell
If cell.Offset(0, 1).Value = fValue.Offset(0, 3).Value Then
cell.Offset(0, 5).Copy
Sheet2.Range("E14").PasteSpecial xlPasteValues
End If
NextCell:
Next cell
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Display More

I have attached my test work book for you to peruse. There are some notes for you in both sheets. You should be able to run the code from either sheet.

I hope that this helps.

Cheerio,
vcoolio.

vcoolio · Jun 24th 2016

Re: Find string match in column then paste adjacent cell

Hello again TS,

Just thought that you may be interested in an alternative code to do the same job:-

Code

Sub FindStuff()
Dim lr As Long
Dim i As Integer
lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lr
If UCase(Sheet2.Cells(1, 3).Value) = UCase(Sheet1.Cells(i, 1).Value) Then
Sheet2.Cells(14, 5).Value = Sheet1.Cells(i, 1).Offset(, 5).Value
End If
Next i
End Sub

Display More

Cheerio,
vcoolio.

apo · Jun 26th 2016

Re: Find string match in column then paste adjacent cell

Hi..

Here's another one that should work.. just change the 10 000 to a higher number if needed..

It evaluates a very basic formula and then Transposes it to a 1D array so it can then be filtered for the value you're looking for..

In your case.. I would probably put it on the sheet change event (looking at C1 only) and make it clear cell E14 before it executes the code below.

Code

Sub test()
Sheets(2).[E14] = Filter(Application.Transpose(Evaluate("=If(Sheet2!C1=Sheet1!A1:A10000,Sheet1!F1:F10000,""~"")")), "~", False)
End Sub

tswood · Jun 27th 2016

Re: Find string match in column then paste adjacent cell

Hello,

Thank you so much for taking the time to assist.

Both examples are fantastic and easy for to follow for a newcomer like myself.

I did have a couple more questions:

- Currently, the text in cell 'C' on sheet 2 uses a formula. Is there a ways to amend the code to read this cell? or does it have to be pure text?
- Is there a way to amend the code so that it finds a partial match if the text is not identical?
- What is Column A in sheet 2 is merged with columns B:C?

Thanks so much

tswood · Jun 27th 2016

Re: Find string match in column then paste adjacent cell

Hi there,

So simple, thank you! Really highlights how new I am to VBA

Cell 'C' on sheet 2 uses a formula to link to a specific cell in sheet 1 currently which is making the code ineffective.
I'm at a loss as to what a potential workaround for this issue could be.

Any thoughts?

apo · Jun 27th 2016

Re: Find string match in column then paste adjacent cell

Hi..

Second go... formulas are definitely not my strength.. probably a better formula can be made..

Code

Sub Test2()
Sheets(2).[E14] = Evaluate("=INDIRECT(""Sheet1!F"" & MATCH(""*""&Sheet2!A1&""*"",Sheet1!$A$1:$A$10000,0))")
End Sub

Quote

- Currently, the text in cell 'C' on sheet 2 uses a formula. Is there a ways to amend the code to read this cell? or does it have to be pure text?

Seems to read fine when there is a formula used in C1 (in this and last code)..

Quote

- Is there a way to amend the code so that it finds a partial match if the text is not identical?

Try this second version.. it uses a wild card and Match function.

Quote

- What is Column A in sheet 2 is merged with columns B:C?

Reference Cell A1 instead of C1 does the job for me.

vcoolio · Jun 28th 2016

Re: Find string match in column then paste adjacent cell

Hello TS,

APO has done his bit so I suppose I should cover my bit in regards your last query.

Firstly:-

Code

Is there a way to amend the code so that it finds a partial match if the text is not identical?

I've re-done the code using four Boolean tests (true or false) to cover various scenarios. Code is as follows:-

Code

Sub FindThings()
Application.ScreenUpdating = False
Dim lRow As Long
Dim Srch As String
Dim T1 As Boolean, T2 As Boolean, T3 As Boolean, T4 As Boolean
lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Srch = Sheet2.Range("C1").Value
For Each cell In Sheet1.Range("A2:A" & lRow)
T1 = UCase(cell.Value) = UCase(Srch)
T2 = UCase(cell.Value) Like UCase(Srch) & "*"
T3 = UCase(cell.Value) Like "*" & UCase(Srch)
T4 = UCase(cell.Value) Like "*" & UCase(Srch) & "*"
If Application.Or(T1, T2, T3, T4) Then
cell.Offset(, 5).Copy
Sheet2.Range("E14").PasteSpecial xlPasteValues
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Display More

It should cover partial matches, upper/lower case etc.. But be wary of words with similar beginnings such as "cat" and "canary". Don't just place "ca" into the search.

Secondly:-

Quote

Currently, the text in cell 'C' on sheet 2 uses a formula. Is there a ways to amend the code to read this cell? or does it have to be pure text?

I assume that you mean that C1 has a formula that drags a value from another part of the work sheet and you don't want the formula overwritten by a direct entry into C1. That's fine, but it may be best to use the code as a WorkSheet_Change event which means that the code needs to be placed into the work sheet module.
To do this, right click on the sheet2 tab (or whichever sheet has the C1 input cell), and select "view code" from the menu that appears. In the big white field that then appears, paste the following code:-

Code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
Dim Srch As String
Dim T1 As Boolean, T2 As Boolean, T3 As Boolean, T4 As Boolean
If Intersect(Target, Range("F14")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Srch = Sheet2.Range("C1").Value
For Each cell In Sheet1.Range("A2:A" & lRow)
T1 = UCase(cell.Value) = UCase(Srch)
T2 = UCase(cell.Value) Like UCase(Srch) & "*"
T3 = UCase(cell.Value) Like "*" & UCase(Srch)
T4 = UCase(cell.Value) Like "*" & UCase(Srch) & "*"
If Application.Or(T1, T2, T3, T4) Then
cell.Offset(, 5).Copy
Sheet2.Range("E14").PasteSpecial xlPasteValues
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Display More

(Same code, slightly modified for a WorkSheet_Change event).

For the sake of the exercise, in the attached test work book, I have used cell F14 as the data source for cell C1. In C1, I have placed the formula "=F14" (without the parentheses of course).
So, every time C1 registers a value from F14, that value will be searched for in Column A of sheet1 returning a value from sheet1 Column F in sheet2, cell E14. Of course you'll need to click away from F14 (or press Enter or down arrow).

The "Compare Sheet Values(3)" work book attached below has the WorkSheet_Change event code in it.

Thirdly:-

Quote

What is Column A in sheet 2 is merged with columns B:C?

Don't do it! Merged cells create havoc with codes.

I hope that this helps.

Cheerio,
vcoolio.

tswood · Jun 30th 2016

Re: Find string match in column then paste adjacent cell

Hi vcoolio,

Thank you for your comprehensive instructions.

I'm having some issues with the following line:

Code

If Intersect(Target, Range("Budget 2016-17!A6")) Is Nothing Then Exit Sub

It keeps producing the error below:

Run-time error '1004': Method 'Range' of object '_Worksheet' failed

Can you see where I am going wrong at all?

Thanks.

skywriter · Jun 30th 2016

Re: Find string match in column then paste adjacent cell

Did you write that code or is it in what was given to you?

tswood · Jun 30th 2016

Re: Find string match in column then paste adjacent cell

Hello,

I have adapted it slightly from the third suggestion vcoolio provided so that it reflects the sheet I want referenced.

thanks

vcoolio · Jun 30th 2016

Re: Find string match in column then paste adjacent cell

Hello TS,

No need to do what you have done. A Worksheet_Change event has to go in the sheet module from where all the action is happening, so to speak. So, go back to that line and change only the cell reference from where cell C1 is drawing the data from (I used F14 as the source so change this to suit) and make sure that the code goes into the active sheet module (sheet2 in the sample I provided).

Cheerio,
vcoolio.

skywriter · Jun 30th 2016

Re: Find string match in column then paste adjacent cell

If it's worksheet change event code, meaning that's it's in a worksheet module and the first line looks like this:

Code

Private Sub Worksheet_Change(ByVal Target As Range)

Then target would be the cell or cells that were changed on the sheet.
Intersect means any cells that share a common cell or cells, therefore the range you are comparing to target would have to be on the same sheet and would be simply referred to as such.

Code

If Intersect(Target, Range("A6")) Is Nothing Then Exit Sub

If you are trying to refer to a sheet other than the sheet target is on it will not work as cells on one sheet can never intersect with cells on another sheet.

tswood · Jul 1st 2016

Re: Find string match in column then paste adjacent cell

Hi vcoolio & skywriter,

I think that I am on the same page as you now so to speak.

So there is no way to use the 'Intersect' function to reference a cell that is on a different sheet. Correct?

Currently my workbook contains the following:

Sheet 2
- Cell C1 ='Sheet 1'!A6

Sheet 3
- Cell C1 ='Sheet 1'!A7

Sheet 4
- Cell C1 ='Sheet 1'!A8

and so on...

Is there any other way I could approach this task of trying to find the relevant match on sheet 1 for each of the other sheets?

Thank you for your patience with me also.

tswood · Jul 1st 2016

Re: Find string match in column then paste adjacent cell

also...

When I try the code below, Run-time error '424' appears 'Object required'

Code

Sub FindThings()
Application.ScreenUpdating = False
Dim lRow As Long
Dim Srch As String
Dim T1 As Boolean, T2 As Boolean, T3 As Boolean, T4 As Boolean
lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Srch = Sheet2.Range("C1").Value
For Each cell In Sheet1.Range("A6:A" & lRow)
T1 = UCase(cell.Value) = UCase(Srch)
T2 = UCase(cell.Value) Like UCase(Srch) & "*"
T3 = UCase(cell.Value) Like "*" & UCase(Srch)
T4 = UCase(cell.Value) Like "*" & UCase(Srch) & "*"
If Application.Or(T1, T2, T3, T4) Then
cell.Offset(, 5).Copy
Sheet2.Range("E14").PasteSpecial xlPasteValues
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Display More

The issues is arising from this line...

Code

Srch = Sheet2.Range("C1").Value

vcoolio · Jul 3rd 2016

Re: Find string match in column then paste adjacent cell

Hello TS,

Quote

So there is no way to use the 'Intersect' function to reference a cell that is on a different sheet. Correct?

Yes, that is correct. But there are other ways.

It may be best if you upload a sample of your work book. Use dummy data. We'll see what we can do from there.

Cheerio,
vcoolio.

skywriter · Jul 3rd 2016

Re: Find string match in column then paste adjacent cell

[ATTACH=CONFIG]69592[/ATTACH]

Just to make sure we're all on the same page take a look at the image above.
When you are in the VBE and looking at the project explorer you will notice that for every worksheet in your workbook there are two names for each sheet.
In my example the first sheet has the name Sheet1 on the left and then on the right the name is (Main).
The name on the right is always the tab name for the worksheet, the name the user sees at the bottom of the sheet.
If you look at the properties window on the right you will see the boxes where you would change each of these names.
The name on the left is referred to as the code name.
When you create a blank workbook you will notice that the names are the same.
Perhaps Sheet1(Sheet1) would be what you see in the properties window.
When this is the case I can refer to the sheet in code with the following.

Code

Sheet1.Range("A1").Value = 13
Worksheets("Sheet1").Range("A1").Value = 13

The first example is an example of using the code name for the sheet.
You can also use this syntax if you create a worksheet variable.

Code

Dim wsOne As Worksheet
Set wsOne = Worksheets("Sheet1")
wsOne.Range("A1").Value = 13

With my example notice the third sheet is wsAccounts(Sheet3).
If I use the following code I get an error.

Code

Sheet3.Range("A1").Value = 13

That syntax can only be used with the code name or a worksheet variable referring to the sheet. In this case the code name is not Sheet3 it's wsAccounts, therefore either of the following two code examples has to be used.

Code

wsAccounts.Range("A1").Value = 13
Worksheets("Sheet3").Range("A1").Value = 13

You said you had an error with this line.

Code

Srch = Sheet2.Range("C1").Value

If the code name of your sheet is not Sheet2 or you have not created a worksheet variable and set it to an existing sheet, this code will cause an error.

tswood · Jul 4th 2016

Re: Find string match in column then paste adjacent cell

ozgrid.com/forum/core/index.php?attachment/69594/

I have attached a very rough version the spreadsheet I am trying to work with.

Thank you both for your suggestions.

Hopefully you will be able to see where I have gone wrong.

skywriter · Jul 4th 2016

Re: Find string match in column then paste adjacent cell

I don't see a sub procedure titled FindThings, I see code that looks like that in every worksheet change event including the workbook module, that code will not run at all by any worksheet changing, the workbook worksheet change event has a title line that should look like this.

Code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

None of your code will get past the intersect line because, again, you can't intersect a cell on another sheet with the cell that triggered the code.
Intersect is the cells they have in common. They are on different sheets they don't have a cell in common.

tswood · Jul 5th 2016

Re: Find string match in column then paste adjacent cell

Hello,

My apologies... I thought that there was a potential work-around.

I have managed to get the formula working by including the title (source) data on the active sheet (sheet 5) so that there is an intersect.

The code it very long winded though and I feel that there must be a shorter version. Also, I'm wondering it it is possible to have the code update automatically when changes are made to the 'source sheet' (sheet 1) rather than having to click on the individual cell every time to update. Is this possible?

I have included my code below for reference.

Code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
Dim Srch As String
Dim T1 As Boolean, T2 As Boolean, T3 As Boolean, T4 As Boolean
If Intersect(Target, Range("U13")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Srch = Sheet5.Range("C1").Value
For Each cell In Sheet1.Range("A2:A" & lRow)
T1 = UCase(cell.Value) = UCase(Srch)
T2 = UCase(cell.Value) Like UCase(Srch) & "*"
T3 = UCase(cell.Value) Like "*" & UCase(Srch)
T4 = UCase(cell.Value) Like "*" & UCase(Srch) & "*"
If Application.Or(T1, T2, T3, T4) Then
cell.Offset(, 26).Copy
Sheet5.Range("E6").PasteSpecial xlPasteValues
cell.Offset(, 27).Copy
Sheet5.Range("E7").PasteSpecial xlPasteValues
cell.Offset(, 28).Copy
Sheet5.Range("E8").PasteSpecial xlPasteValues
cell.Offset(, 29).Copy
Sheet5.Range("E9").PasteSpecial xlPasteValues
cell.Offset(, 5).Copy
Sheet5.Range("E14").PasteSpecial xlPasteValues
cell.Offset(, 6).Copy
Sheet5.Range("E15").PasteSpecial xlPasteValues
cell.Offset(, 7).Copy
Sheet5.Range("E16").PasteSpecial xlPasteValues
cell.Offset(, 8).Copy
Sheet5.Range("E17").PasteSpecial xlPasteValues
cell.Offset(, 9).Copy
Sheet5.Range("E18").PasteSpecial xlPasteValues
cell.Offset(, 10).Copy
Sheet5.Range("E19").PasteSpecial xlPasteValues
cell.Offset(, 11).Copy
Sheet5.Range("E20").PasteSpecial xlPasteValues
cell.Offset(, 12).Copy
Sheet5.Range("E22").PasteSpecial xlPasteValues
cell.Offset(, 13).Copy
Sheet5.Range("E23").PasteSpecial xlPasteValues
cell.Offset(, 14).Copy
Sheet5.Range("E24").PasteSpecial xlPasteValues
cell.Offset(, 15).Copy
Sheet5.Range("E25").PasteSpecial xlPasteValues
cell.Offset(, 16).Copy
Sheet5.Range("E26").PasteSpecial xlPasteValues
cell.Offset(, 17).Copy
Sheet5.Range("E28").PasteSpecial xlPasteValues
cell.Offset(, 18).Copy
Sheet5.Range("E29").PasteSpecial xlPasteValues
cell.Offset(, 19).Copy
Sheet5.Range("E31").PasteSpecial xlPasteValues
cell.Offset(, 20).Copy
Sheet5.Range("E32").PasteSpecial xlPasteValues
cell.Offset(, 21).Copy
Sheet5.Range("E33").PasteSpecial xlPasteValues
cell.Offset(, 22).Copy
Sheet5.Range("E34").PasteSpecial xlPasteValues
cell.Offset(, 23).Copy
Sheet5.Range("E35").PasteSpecial xlPasteValues
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Display More

Thank you again

Share