VBA If text is found in range, replace with text from another cell, based on partial match with adjacent cell

[MikeMB]

Hi. I am a new member of this forum and need some help please.

I have created an Excel spreadsheet with macros where players and visitors entered from drop down lists in sheet 1 are randomized in sheet 2 as the example above.

I have tried without success, to extend the macro to substitute the names of the Visitors in column C for Visitor02, 01 & 03 in Sheet 2 column D, based on a partial match to the Visitor Nos (V02 - V03) in column B sheet 1. All as shown in the column on the right.

Any help would be greatly appreciated.

 

[Legacy 143009]

Like this?

Sub myFunction()
  Dim lRow as Long
  lRow = Worksheets("Sheet 2").Cells(Rows.Count, 4).End(xlUp).Row
  With Worksheets("Sheet 2")
  For i = 3 to lRow
    If Left(.Cells(i, 4).Value, 7) = "Visitor" Then
      .Cells(i, 4).Value = Worksheets("Sheet 1").Cells(Application.Match(Left(.Cells(i, 4).Value, 1) & Right(.Cells(i, 4).Value, 2), Worksheets("Sheet 1").Range("B:B"), 0) ,3).Value
    End If
  Next
  End With
End Sub

 

[MikeMB]

Thank you for your reply and sorry it has taken so long for me to respond but I am still wrestling with the problem.
At first your suggestion did not work but after I deleted the spaces between each instance of "Sheet" and the number it worked beautifully. I have been trying to follow the logic in your code but with my limited knowledge it is beyond me.
My present problem is trying to incorporate the code into the macro in my workbook which has several sheets.
I have inserted the slightly modified code into the existing macro which continues to run successfully. The added code does not seem to cause any problems but it does not have any effect and seems to be ignored. If I could understand the logic in your code I think I would have a better chance of finding and correcting the problem.

 

[Legacy 143009]

Please find my brake down and comments below:

Sub myFunction()
  Dim lRow as Long, matchRow As Long, combinedWord As String
  lRow = Worksheets("Sheet2").Cells(Rows.Count, 4).End(xlUp).Row 'Find last used row in Sheet2
  With Worksheets("Sheet2") 'After this point all object start with "." will refer to Sheet2
  For i = 3 to lRow 'i is a variable for row 3 to last row
    If Left(.Cells(i, 4).Value, 7) = "Visitor" Then 'If Sheet 2-Column 4 (D) value's left 7 character is "Visitor"
      combinedWord = Left(.Cells(i, 4).Value, 1) & Right(.Cells(i, 4).Value, 2) 'Take first letter from left "V", take two digits from right.
      matchRow = Application.Match(combineWord, Worksheets("Sheet1").Range("B:B"), 0) 'Get the matching row number in Sheet1 Column B with generic match funtion.
      .Cells(i, 4).Value = Worksheets("Sheet1").Cells(matchRow ,3).Value 'Sheet2 same value will be Sheet1 Column 3 (C) matching row value
    End If
  Next
  End With
End Sub

I hope this will provide a better understanding.

 

[MikeMB]

Thank you very much. I will study your post and let you know how I get on. It may take some time!

 

[MikeMB]

Thank you once again for your help and advice. I could not have achieved what I needed without your help.

I adapted your suggestion to suit my final requirements.



The code is as follows:

Sub myFunction()
Dim lRow As Long, matchRow As Long, combinedWord As String
lRow = Worksheets("Sheet2").Cells(Rows.Count, 17).End(xlUp).Row 'Find last used row in Col Q Sheet2
lRow = Worksheets("Sheet2").Cells(Rows.Count, 18).End(xlUp).Row 'Find last used row in Col R Sheet2
lRow = Worksheets("Sheet2").Cells(Rows.Count, 19).End(xlUp).Row 'Find last used row in Col S Sheet2
With Worksheets("Sheet2") 'After this point all object start with "." will refer to Sheet2
For i = 2 To lRow 'i is a variable for row 2 to last row
If Left(.Cells(i, 17).Value, 8) = "zVisitor" Then 'If Sheet 2-Column 17 (Q) value's left 8 character is "z"
combinedWord = Left(.Cells(i, 17).Value, 2) & Right(.Cells(i, 17).Value, 2) 'Take first and second letter from left "V", take two digits from right.
matchRow = Application.Match(combinedWord, Worksheets("Sheet1").Range("D:D"), 0) 'Get the matching row number in Sheet1 Column D with generic match function.
.Cells(i, 17).Value = Worksheets("Sheet1").Cells(matchRow, 3).Value 'Sheet2 same value will be Sheet1 Column 4 (D) matching row value
End If
If Left(.Cells(i, 18).Value, 8) = "zVisitor" Then 'If Sheet 2-Column 18 (Q) value's left 8 character is "z"
combinedWord = Left(.Cells(i, 18).Value, 2) & Right(.Cells(i, 18).Value, 2) 'Take first and second letter from left "V", take two digits from right.
matchRow = Application.Match(combinedWord, Worksheets("Sheet1").Range("D:D"), 0) 'Get the matching row number in Sheet1 Column D with generic match function.
.Cells(i, 18).Value = Worksheets("Sheet1").Cells(matchRow, 3).Value 'Sheet2 same value will be Sheet1 Column 4 (D) matching row value
End If
If Left(.Cells(i, 19).Value, 8) = "zVisitor" Then 'If Sheet 2-Column 19 (Q) value's left 8 character is "z"
combinedWord = Left(.Cells(i, 19).Value, 2) & Right(.Cells(i, 19).Value, 2) 'Take first and second letter from left "V", take two digits from right.
matchRow = Application.Match(combinedWord, Worksheets("Sheet1").Range("D:D"), 0) 'Get the matching row number in Sheet1 Column D with generic match function.
.Cells(i, 19).Value = Worksheets("Sheet1").Cells(matchRow, 3).Value 'Sheet2 same value will be Sheet1 Column 4 (D) matching row value
End If

Next
End With
End Sub

I guess there may be a way of shortening my code but it seems to work well as it is.

 

[Legacy 143009]

Hello!

I am glad it did help you. The following code would allow more resiliency if you want to add more columns or more names into different columns.

Sub myFunction()
  Dim lRow As Long, matchRow As Long, combinedWord As String
  With Worksheets("Sheet2") 'After this point all object start with "." will refer to Sheet2
  lRow = .Range("Q:S").SpecialCells(xlCellTypeLastCell).Row 'Better if you want to find last used row for either 3 columns.
  For c = 17 To 19 'For each column from 17 to 19 if it is always going to be from Q to S.
    For r = 2 To lRow 'For each row from 2 to last used
        'The rest is the same logic
        If Left(.Cells(r, c).Value, 8) = "zVisitor" Then
        combinedWord = Left(.Cells(r, c).Value, 2) & Right(.Cells(r, c).Value, 2)
        matchRow = Application.Match(combinedWord, Worksheets("Sheet1").Range("D:D"), 0)
        .Cells(r, c).Value = Worksheets("Sheet1").Cells(matchRow, 3).Value
      End If
    Next
  Next
  End With
End Sub

 

[MikeMB]

Hi
Thanks for the shortened code - it works well!