Excel VBA Macro: Iterating over values on one page

Question

What I want to do: Iterate over values on one page to check for match on another page and if a match is found take a value from 2nd page same row but different column.

I've been trying now for quite some time. I'm new to VBA-scripting / Excel and might be approaching the problem incorrectly, hence why I'm asking here!

My code so far:

Sub InsertData()
ScreenUpdating = False


Dim wks As Worksheet

Dim subSheet As Worksheet
Set subSheet = Sheets("Sheet4")
Dim rowRangeSub As Range
Dim LastRowSub As Long
LastRowSub = subSheet.Cells(subSheet.Rows.Count, "C").End(xlUp).Row
Set rowRangeSub = subSheet.Range("C2:C" & LastRowSub)
Dim subGroupList As ListObject


Dim rowRange As Range
Dim colRange As Range

Dim LastCol As Long
Dim LastRow As Long

Dim Found As Range
'START OF SHEET1'
Set wks = Sheets("SHEET1")
LastRow = wks.Cells(wks.Rows.Count, "B").End(xlUp).Row

Set rowRange = wks.Range("B2:B" & LastRow)
'Loop through each row in B column (Names)'
For Each rrow In rowRange
    If Not IsEmpty(rrow) Then
        With Sheets("Sheet4").Range("C2:C" & LastRowSub)

            Set Found = .Find(What:=rrow, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Found Is Nothing Then
                'Debug.Print "Found"'
                wks.Cells(rrow.Row, "K").Value = "Found"
            Else
                wks.Cells(rrow.Row, "K").Value = "Not Found"

                'Debug.Print "Not Found"'
            End If
        End With
    End If
Next rrow

'END OF SHEET1'
'START OF SHEET2'
Set wks = Sheets("SHEET2")
LastRow = wks.Cells(wks.Rows.Count, "B").End(xlUp).Row
Set rowRange = wks.Range("B2:B" & LastRow)

'END OF SHEET2'
'START OF SHEET3'
Set wks = Sheets("SHEET3")
LastRow = wks.Cells(wks.Rows.Count, "B").End(xlUp).Row
Set rowRange = wks.Range("B2:B" & LastRow)

'END OF SHEET3'


ScreenUpdating = True
End Sub

The setup in the Excel file is as such: The three sheets, Sheet1, Sheet2, Sheet3 contains a lot of data in its 10 first columns (A-J) and the 11th column (K) is where the data is to be inserted if it is found. Pertinent data, names, is found in column B where B:1 is just "Name" as a title. There is also some empty cells in the column to take into consideration.

The 4th sheet, Sheet4 contains some data in its 5 first columns. The names which are to be matched can be found in column C, and if a match is found it is supposed to collect data from the Cells(Found.Row, "E") where "E" is column E.

This problem has been screwing with my head quite a lot since .Find()-function seems to not work as I expect it to, as in it finds the opposites sometimes.

My main question is: How do I assign the correct value to the row?

wks.Cells(rrow.Row, "K").Value = rowRangeSub.Cells(Found.Row, "E").Value

I feel like I've tested at least 10 different ways to assign, but I keep on getting error after error. Most of the time it's a missmatch error.

Any help is appreciated!

EDIT since reading comments: Ok, here it goes : All columns are formatted as text. Column A: Personal numbers: not relevant Column B: Names: Form is: Lastname, Firstname. This is to be used when searching for a match. Column C to J not relevant with various information about a person. Column K: This columns cell starts out empty. This is to be filled by the macro.

I have three different books within the Excel file that have data that looks like what I've explained, just different data in each book.

The 4th book is as such: Column A and B is not relevant with info not needed at all.

Column C: Is the names in form Lastname, Firstname. This is what should be the column cells to compare with column B's cells in the other books.

Column D: Not relevant

Column E: This is the important part of Sheet4. For every person there is a "group number" that can be found in this column for every row.

What I want to do is compare each cell in column B in Sheet1-3 for a match in column C in Sheet4. If a match is found (not all are assigned a group, so matches might not be found) then take cell information from Sheet4 on the row which a match was found and column "E", put this information in the row in Sheet1-3 and column "K".

Example data (is there a way to submit tables?): Sheet1:

COLUMN B

Tablesson, Pen

Paper, Ink

Eraser, Screen

COLUMN K is at this moment empty

Sheet4:

COLUMN C

Paper, Ink

Eraser, Screen

COLUMN E

55

77

RUNS THE MACRO, Sheet1 after macro:

COLUMN B

Tablesson, Pen

Paper, Ink

Eraser, Screen

COLUMN K

[First entry is empty since no match was found]

55

77

Hopefully this is understandable!

Answer 1

Sub InsertData()
    Dim lastRow As Long, x As Long
    Dim dicNames, k As String, v As Variant

    Set dicNames = CreateObject("scripting.dictionary")
    'Create list of Names to compare against and values to update
    With Worksheets("Sheet4")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        For x = 2 To lastRow
        
            k = .Cells(x, 3).Value  'Name from Column C
            v = .Cells(x, 5).Value  'Value From Column E

            'Add Key Value pairs to Dictionary
            If Not dicNames.Exists(k) Then dicNames.Add k, v
        Next
    End With

    ProcessWorksheet Worksheets("Sheet1"), dicNames
    ProcessWorksheet Worksheets("Sheet2"), dicNames
    ProcessWorksheet Worksheets("Sheet3"), dicNames

End Sub

Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames)
    Dim k As String, v As Range
    Dim lastRow As Long, x As Long
    With ws
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        For x = 2 To lastRow
            k = .Cells(x, 2)    'If Name from Column B
            If dicNames.Exists(k) Then
                .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4
            End If
        Next
    End With
End Sub

Basically used the code provided by Thomas Inzina with minor changes:

    If dicNames.Exists(k) Then
        newV = IIf(dicNames(k) = v, v, dicNames(k) & "," & v)
        dicNames.Remove (k)
        dicNames.Add k, newV
    Else
        dicNames.Add k, v
    End If

This takes duplicates into consideration.

I also used this cleaning function since I couldn't find the built-in one in VBA. Used them as such:

k = CleanTrim(.Cells(X, 3).Value)  'Name from Column C
k = CleanTrim(.Cells(X, 2).Value)  'If Name from Column B

Answer 2

I simplified the process by using a Scripting Dictionary.

Sub InsertData()
    Dim lastRow As Long, x As Long
    Dim dicNames, k As String, v As Variant

    Set dicNames = CreateObject("scripting.dictionary")
    'Create list of Names to compare against and values to update
    With Worksheets("Sheet4")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        For x = 2 To lastRow
        
            k = .Cells(x, 3).Value  'Name from Column C
            v = .Cells(x, 5).Value  'Value From Column E

            'Add Key Value pairs to Dictionary
            If Not dicNames.Exists(k) Then dicNames.Add k, v
        Next
    End With

    ProcessWorksheet Worksheets("Sheet1"), dicNames
    ProcessWorksheet Worksheets("Sheet2"), dicNames
    ProcessWorksheet Worksheets("Sheet3"), dicNames

End Sub

Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames)
    Dim k As String, v As Range
    Dim lastRow As Long, x As Long
    With ws
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        For x = 2 To lastRow
            k = .Cells(x, 2)    'If Name from Column B
            If dicNames.Exists(k) Then
                .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4
            End If
        Next
    End With
End Sub