-1

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
Zoe
  • 27,060
  • 21
  • 118
  • 148
vinmeg
  • 41
  • 5
  • 1
    This site is not a free coding service. Please show us your current code. If you don't have any, I would 1) get last row of sheet2, 2) add the desired range of sheet2 (prefixes) to an array, 3) loop trough all rows of Sheet1, checking if Left of each cell value [is in the array](https://stackoverflow.com/questions/38267950/check-if-a-value-is-in-an-array-or-not-with-excel-vba). – CMArg Aug 10 '18 at 13:26

2 Answers2

0
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
vinmeg
  • 41
  • 5
  • This was my last attempt where I was able to detect the prefixes in the same sheet. I did not have a working code that could compare among two sheets. – vinmeg Aug 10 '18 at 14:17
  • Please include your code in the question, not as an answer! That said, you should replace (as an example) `Cells(1 + i, 1).Value` with `Worksheets("Sheet1").Cells(1 + i, 1).Value`. In this way you are explicity stating the worksheet name. – CMArg Aug 10 '18 at 14:28
0

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
CMArg
  • 1,525
  • 3
  • 13
  • 28
  • Thank you your code does the trick, I agree with your comment, would like to change from Message Boxes into highlight all the cells that are False. Is that possible when use an Array? – vinmeg Aug 10 '18 at 23:07
  • See edited answer. Mark as accepted if it fit your needs please..:) – CMArg Aug 12 '18 at 00:25
  • Hi, I used the above mentioned code with success, only got an additional requirement to be added, whci I do not get to work because I am not strong with arrays. – vinmeg Aug 17 '18 at 10:11
  • Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) End Function – vinmeg Aug 17 '18 at 10:12
  • I need to add a test that skips values that has string value on "Sheet1" less than 4 characters – vinmeg Aug 17 '18 at 10:13
  • This is the code I have now wich runs into error variable not defined. – vinmeg Aug 17 '18 at 10:30
  • Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean For Each tmpSrch In arr If Len(tmpSrch) > 4 Then IsInArray = False Exit Function Else IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) Next End Function – vinmeg Aug 17 '18 at 10:30
  • See edited answer. Skipping the values with less than 3 characters is performed in the loop, not in `IsInArray`. – CMArg Aug 17 '18 at 11:16