VBA to match Value from Sheet 'A" against Sheet 'B' then copy information

[Gawddofwar]

Hi all,

I apologize but I am a newbie in VBA, I have visited several tutorials and match their codes together to achieve what I wanted but it does not work.. (sometimes my code works by matching several tutorials)

Basically, the code looks up cell value from the sheet "Client Experience" starting from cell B3 against Column A of sheet "Admin Upload (Sessions)", if it finds a match, it will copy the value 9 columns to the right in sheet "Admin Upload (Sessions)" - note there can be more than 1 results, and paste it in sheet "Client Experience" 14 columns to the right.

As there can be more than 1 returning results, the subsequent results will be pasted 4 columns to the right of column 14 and so on and so for.

However if the cell column in column 14 is filled, it will offset another 4 columns to find the next available cell (Currently I do not know how to do this, so I just copy and paste the same code with the IF isEmpty function with adjustments to ws.Cells (x, y) - e.g ws.Cells (x, y+4). So if column 14 is filled, the code will paste the results 4 columns to the right (assuming it is empty), so I copy the code around 20 times... yeah...

I appreciate any help, I don't mind copying the code 20times, just need the function where the code can complete the search for the first cell in sheet "Client Experience", and move on to the next cell below - b4, b5, b6 and so on.

Sub Test2()
      
      
Dim searchResult As Range, firstAddress As String
Dim x As Long, ws As Worksheet
Set ws = Worksheets("Client Experience")
Dim rStart As Range
Set rStart = Selection
With ActiveChart
        .SetSourceData Source:=rStart
    
    x = .rStart
    y = 16
    
      
' Select cell B3, *first line of data*.
Range("B3").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
' Insert your code here.
         
ActiveWorkbook.Worksheets("Client Experience").rStart.Offset(0, 14).Select
If IsEmpty(ActiveCell.Value) Then
        
'Search for "Activity" and store in Range
With Worksheets("Admin Upload (Sessions)").Range("A:A")
        Set searchResult = .Find(What:=ActiveWorkbook.Worksheets("Client Experience").rStart, LookIn:=xlFormulas, After:=.Cells(.Rows.Count, .Columns.Count), _
                                 LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                 MatchCase:=False, SearchFormat:=False)
        ' Store the address of the first occurrence of this word
        firstAddress = searchResult.Address
        Do
            ' Set the value in the O column, using the row number and column number
            ws.Cells(x, y) = searchResult.Offset(0, 9).Value
            ' Increase the counter to go to the next column
            y = y + 4
            ' Find the next occurrence of "Activity"
            Set searchResult = .FindNext(After:=searchResult)
            'Debug.Print SearchResult.Address(0, 0, external:=True)
            ' Check if a value was found and that it is not the first value found
        Loop While Not searchResult Is Nothing And firstAddress <> searchResult.Address
End With
    Set ws = Nothing
    
Else

ActiveWorkbook.Worksheets("Client Experience").rStart.Offset(0, 18).Select
If IsEmpty(ActiveCell.Value) Then
       
    ' Search for "Activity" and store in Range
    With Worksheets("Admin Upload (Sessions)").Range("A:A")
        Set searchResult = .Find(What:=ActiveWorkbook.Worksheets("Client Experience").rStart, LookIn:=xlFormulas, After:=.Cells(.Rows.Count, .Columns.Count), _
                                 LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                 MatchCase:=False, SearchFormat:=False)
        ' Store the address of the first occurrence of this word
        firstAddress = searchResult.Address
        Do
            ' Set the value in the O column, using the row number and column number
            ws.Cells(x, y + 4) = searchResult.Offset(0, 9).Value
            ' Increase the counter to go to the next column
            y = y + 4
            ' Find the next occurrence of "Activity"
            Set searchResult = .FindNext(After:=searchResult)
            'Debug.Print SearchResult.Address(0, 0, external:=True)
            ' Check if a value was found and that it is not the first value found
        Loop While Not searchResult Is Nothing And firstAddress <> searchResult.Address
    End With
    Set ws = Nothing
End If
End If
' Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select

Loop

End Sub

 

[Gawddofwar]

Ok I found a much more efficient method, hopefully it helps whoever is looking for the same thing as me.

Sub test3()
Dim searchlist As Range
Dim rcell As Range, sValue As String
Dim lcol As Long, cRow As Long
Dim dRange As Range, sCell As Range
'Values you wish to search data on
Set searchlist = Sheets("Client Experience").Range("B3:B202")
'Data Range to search
Set dRange = Sheets("Admin Upload (Sessions)").Range("A3:A102")
For Each rcell In searchlist
  lcol = 14 'assuming nothing is on sheet2 other than in col a
  'loop through data and add value of col C to the results to this row if match is found ount in the next availible column
  For Each sCell In dRange
     If InStr(1, sCell.Value, rcell.Value) And Trim(rcell.Value) <> "" Then 'if sheet2 a value part of a string in data then
        'If sCell.Value = rcell.Value Then 'match found
        rcell.Offset(0, lcol).Value = sCell.Offset(0, 8).Value
        lcol = lcol + 4
     End If
  Next
Next
End Sub

However this code replaces the existing data in column 14 (or it's +4) in sheet "Client Experience" if a new set of data is input in the sheet "Admin Upload (Sessions)", as the sheet "Admin Upload (Sessions)" will clear it's content every time data is ported. Still figuring out how to solve that. But if for your case it only needs to search sheet A against sheet B, then this code will be optimal for you, returning more than 1 value in your specified columns or rows if a match occurs.