Validate if a Prefix in sheet2 has a matching value in sheet1 - excel

Question

I have the following issue: In one workbook I have multiple sheets.
On Sheet 2 in column "D" starting on row 2, Is a list of 300+ prefixes of 4 digits long e.g. XFTZ, GHTU, ZAQS etc.
On Sheet 1 in column "R" starting on row 3, Is a list of 1000+ values that can have the following values e.g.: AAAA1234556 and ZAQS12565865.
The first value AAAA...... is allowed, where the second value ZAQS..... Should throw an error message when running the VBA code.
The list of values in both sheets can grow over time, so I would like to avoid hard coding of records. I would expect best solution here is to use something like this:
LastRowNr = Cells(Rows.Count, 1).End(xlUp).Row

Answer 1

Try something like the following, replacing Sheet1 with the name in which the actual data is located
Option Explicit
Private Sub searchPrefix()
Dim RangeInArray() As Variant
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim tmpSrch As String
Dim i As Long
LastRow1 = Worksheets("Sheet1").Cells(Rows.Count, 18).End(xlUp).Row
LastRow2 = Worksheets("PREFIXES").Cells(Rows.Count, 4).End(xlUp).Row
RangeInArray = Application.Transpose(Worksheets("PREFIXES").Range("D1:D" & LastRow2).Value)
For i = 3 To LastRow1
If Len(Worksheets("Sheet1").Cells(i, 18).Value) >= 3 Then
tmpSrch = Left(Worksheets("Sheet1").Cells(i, 18).Value, 4) '18: column R
If IsInArray(tmpSrch, RangeInArray) Then
Worksheets("Sheet1").Cells(i, 18).Interior.ColorIndex = xlNone
Worksheets("Sheet1").Cells(i, 18).Font.ColorIndex = 0
Worksheets("Sheet1").Cells(i, 18).Font.Bold = False
Else
Worksheets("Sheet1").Cells(i, 18).Interior.Color = RGB(252, 134, 75)
Worksheets("Sheet1").Cells(i, 18).Font.Color = RGB(181, 24, 7)
Worksheets("Sheet1").Cells(i, 18).Font.Bold = True
End If
End If
Next
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

Answer 2

Option Explicit
Sub searchPrefix()
Sheets("PREFIXES").Select
Dim CellCntnt As String
Dim tmpSrch As String
Dim isFound As Boolean
isFound = False
Dim QtySrchChar As Integer
QtySrchChar = 4
Dim Cnt As Integer
Cnt = 0
Dim Tag As Integer
Cells.Range("A1").Select
Do Until IsEmpty(ActiveCell)
Cnt = Cnt + 1
ActiveCell.Offset(1, 0).Select
Loop
For Tag = 1 To Cnt - 1
CellCntnt = Cells(1 + i, 1).Value
tmpSrch = Left(CellCntnt, QtySrchChar)
Cells.Range("G1").Select
Do Until IsEmpty(ActiveCell)
If Left(ActiveCell.Value, QtySrchChar) = tmpSrch Then
QtySrchChar = QtySrchChar + 1
tmpSrch = Left(CellCntnt, QtySrchChar)
isFound = True
MsgBox ("True Tags introduced with Std.Prefix " & tmpSrch)
End If
If isFound Then
isFound = False
MsgBox ("False Tags introduced with Std.Prefix " & tmpSrch)
Cells.Range("G1").Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Next Tag
End Sub