Find Row Value in VBA Range Compare - excel

Question

I am comparing 2 rows, and I stuck on trying to copy the row value of the current cell in the range.
Problem:
I have a list of Employee Codes, I am comparing these employee codes and copying any data that does not exist (ie new employees). I also need to skip the "*" in my range compare
However I have a sheet where the data I need to copy is in the row below the row where the employee code is
Sheets are set up like this
WSUPER
A B C
XXXX ... ...
CCCC ... ...
VVVV ... ...
Marco_data
A B C D V W
xx xx xx XXXX
xx xx xx * ... ...
xx xx xx FFFF
xx xx xx * ... ...
What I need to copy is the different employee code (in this case FFFF (only this cell) and the Values in Columns V and W
This is the code I have, but does not work correctly
' insert new data - This checks each employees code from the raw and compares in the exisiting. If it doesn't exist it inserts the record. If it does it skips to the next
For Each rng In Sheets("Macro_data").Range(Cells(2, 4), Cells(Cells(Rows.Count, "D").End(xlUp).Row, 1))
Set wb1rng = Sheets("WSUPER").Range("A:A").Find(rng, LookIn:=xlValues, LookAt:=xlWhole)
' If rng Like "[A-Za-z0-9]" Then
If wb1rng Is Nothing Then
coprng = rng.Cells.Row
MsgBox coprng
rng.Cells(coprng, 4).Copy
Sheets("WSUPER").Cells(wbpaste, 1).PasteSpecial xlPasteValues
coprng = coprng + 1
Sheets("Macro_Data").Range(Cells(coprng, 21), Cells(coprng, 22)).Copy
Sheets("WSUPER").Cells(wbpaste, 2).PasteSpecial xlPasteValues
wbpaste = wbpaste + 1
addedrecords = addedrecords + 1
End If
' End If
Next rng
wbpaste is the last row + 1 which is will be the row to paste data in
the idea is to grab only employee code which does not exist ("D") and Column V and W from the row below.
I set the coprng as the range value, but this fails
To skip the * i tried the following, but all failed
If rng Like "[A-Za-z0-9]" Then
Any help would be great

Answer 1

Look Up New Records (feat. a 3D Array)
Adjust the constants as you see fit.
Option Explicit
Sub lookupNewRecords()
' Constants
Const srcName As String = "Macro_data"
Const srcFirstRow As Long = 2
Dim srcColumns As Variant: srcColumns = Array(4, 22, 23)
Const tgtName As String = "WSUPER"
Const tgtFirstRow As Long = 2
Const tgtColumn As Long = 1
' Other Variables
Dim src As Worksheet ' Source Worksheet (Object)
Dim tgt As Worksheet ' Target Worksheet (Object)
Dim rng As Range ' Source Criteria Column Last Non-Empty Cell,
' Source Criteria Column Range,
' Target Criteria Column Last Non-Empty Cell,
' Target Criteria Column Range
Dim Source(2) As Variant ' Source Array of Arrays (Columns)
Dim Target As Variant ' Target (Criteria Column) Array
Dim Result() As Variant ' Result Array
Dim tgtFR As Long ' Target First Row
Dim i As Long ' Source Arrays Row Counter
Dim j As Long ' Result Array Columns Counter
Dim k As Long ' Result Array Rows Counter,
' Source Array of Arrays Elements (Arrays) Counter
' Read Source Columns and write to Source Array of Arrays.
Set src = ThisWorkbook.Worksheets(srcName)
Set rng = src.Columns(srcColumns(0)) _
.Find("*", , xlFormulas, , , xlPrevious)
If rng Is Nothing Then Exit Sub
If rng.Row < srcFirstRow Then Exit Sub
Set rng = src.Range(src.Cells(srcFirstRow, srcColumns(0)), rng)
Source(0) = rng
' Note: If you don't need a row offset like OP did,
' delete just the "1"-s included in the "1, "-s.
Source(1) = rng.Offset(1, srcColumns(1) - srcColumns(0))
Source(2) = rng.Offset(1, srcColumns(2) - srcColumns(0))
' Read Target Criteria Column and write to Target Array.
Set tgt = ThisWorkbook.Worksheets(tgtName)
Set rng = tgt.Columns(tgtColumn) _
.Find("*", , xlFormulas, , , xlPrevious)
If rng Is Nothing Then Exit Sub
If rng.Row < tgtFirstRow Then Exit Sub
tgtFR = rng.Row + 1
Set rng = tgt.Range(tgt.Cells(tgtFirstRow, tgtColumn), rng)
Target = rng
Set rng = Nothing ' Necessary data is in Arrays.
' Write to Result Array.
For i = 1 To UBound(Source(0))
If Source(0)(i, 1) <> "*" And _
IsError(Application.Match(Source(0)(i, 1), Target, 0)) Then
ReDim Preserve Result(2, j)
For k = 0 To 2
Result(k, j) = Source(k)(i, 1)
Next k
j = j + 1
End If
Next i
If j = 0 Then GoTo NoData
' Write to Result Range.
tgt.Cells(tgtFR, tgtColumn) _
.Resize(UBound(Result, 2) + 1, UBound(Result) + 1) = _
Application.Transpose(Result)
' Note: The Result Array was transposed because you can only resize
' an array by its last dimension. In this case it had "3" rows and
' "j" columns, but we needed "j" rows and "3" columns.
' Inform user.
Dim msg As String
If j > 1 Then msg = "s"
MsgBox "Transferred " & j & " new record" & msg & ".", _
vbInformation, "Success"
Exit Sub
NoData:
MsgBox "No new records found.", vbExclamation, "No Transfer"
End Sub