Excel VBA Macro: Iterating over values on one page to check for match on another page and assign value - vba

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

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

Answer 2

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