VBA: Compare Cell Contents to Multiple Arrays

[RNELSO2]

Hi Excel Experts,

I need some help creating VBA code that will accomplish a very repetitive task.

I have 2 sheets of data, I need to compare Sheet 1 to a specific range on Sheet 2 and where a value from that range on Sheet 2 appears in the PIO String (column 3) it needs to be removed from the string.

On sheet 2 there are 3 rows of headers that denote the series, code and description, these are for reference only and should not be checked against.

The challenge I have is Columns 1 and 2 need to be used as a reference for which list of values to check against on sheet 2. Column 2 is always 6 characters in length but the comparison only needs to be done against the first 4 characters since that is the layout on Sheet 2

Sheet 1

Series	PIO	PIO STRING
4Runner <tbody> </tbody>	XX1000	CY2000 FP5000 MC2000 PF1000 RB5220 UF60 XY9000
Tacoma 4X2 <tbody> </tbody>	XX1110	CY2000 FP5000 MR1000 PF1000 UF60 XY9000
Tundra 4x2 <tbody> </tbody>	XX1500	BS1000 CY2000 FP5000 LL1000 MR1000 PF1000 RB1100 UF60 XY9000
Camry <tbody> </tbody>	XX1020	CY2000 FP5010 MC1000 PF1000 UF60 XY9000
Tacoma 4X4 <tbody> </tbody>	XX2000	FP4000 MR1000 PF1000 UF60 XY9000
Tacoma 4X4 <tbody> </tbody>	XX2000	FP5000 JB2300 MR1000 UF60
Tundra 4x4 <tbody> </tbody>	XX1300	BS1000 BU1000 FP5000 UF60 XY9000
4Runner <tbody> </tbody>	XX1000	FP4000 MC2010 PF1000 UF60 XY9000
Camry <tbody> </tbody>	XX1020	FP4010 MC1000 UF60 XY9000

<tbody>
</tbody>

Sheet 2: The sheet is 12 columns wide and up to 46 rows long.

4Runner	Tundra
XX10	XX15
Wheel Package	Wheel Package
AC1000	AA2800
AJ1700	AC1000
BG2000	RB1100
RB5220	ET1100
SBXP10	AL6000

<tbody>
</tbody>

In this example, Row 2 on Sheet 1 would be compared to Column 1 on Sheet 2 because they share the same series and first 4 characters of the PIO code. The result would be that Row 2 needs to be altered because RB5220 is present in the corresponding list on Sheet 2 the same goes for Row 4 for RB1100.

The formatting of the end result is sensitive also, Sheet 1 Column 3 needs to maintain a single space between each item.

I hope this comes across clearly, I am happy to clarify further.

As always, thank you in advance for your help.

 

[RNELSO2]

Was able to get this figured out. Posting code below in case it help any wayward travelers.

Dim LookupvalueA1 As StringDim LookupvalueB1 As String
Dim LookupvalueA2 As String
Dim LookupvalueB2 As String
Dim Shortstr As String


Dim LLAB1 As String 'Dummy variable for Sheet1
Dim LLAB2 As String 'Dummy variable for Sheet2


Dim str() As String 'Name of Array
Dim k As Long 'Array index number


Dim lRow As String 'Not used, but can define last row for column A in Sheet 1


Dim ValLookup As String 'Define the Lookup Value for Row "m" in Column "j" for Sheet 1. This will define the value for the cell that contain the cell value for the package
Dim RemoveVal As String 'Create a dummy word that will replace the value in the ORIG_PIO_STRING that you check.


SRESNM_lrow = Cells(Rows.Count, 4).End(xlUp).Row 'Find the last row for column SRES_NM
For i = 2 To SRESNM_lrow 'Loop trough column SRES_NM
LookupvalueA1 = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value 'Define the value in column SRES_NM to check againt in Sheet2, Row 1
LookupvalueB1 = ThisWorkbook.Worksheets("Sheet1").Cells(i, 13).Value 'Define the value in column NEW_PIC to check againt in Sheet2, Row2
LLAB1 = LookupvalueA1 & LookupvalueB1 'Dummy variable. It shows which value from Sheet1 that will be compared in Sheet2 row 1 and 2


    For j = 1 To 12 'The first row from column 1 (A) to Column 12 (L)
    LookupvalueA2 = ThisWorkbook.Worksheets("Sheet2").Cells(1, j).Value 'For Sheet1 loop through row 1 for column j
    LookupvalueB2 = ThisWorkbook.Worksheets("Sheet2").Cells(2, j).Value 'For Sheet1 loop through row 2 for column j
    LLAB2 = LookupvalueA2 & LookupvalueB2 'Dummy variable2. It shows which value from Sheet2 row 1 and 2 that will be compared to the value in Sheet 1


        If LookupvalueA1 & LookupvalueB1 Like LookupvalueA2 & "*" & LookupvalueB2 & "*" Then 'Compare the the values between Sheet 1 and Sheet 2
        'If LLAB1 Like LLAB2 & "*" Then 'Test dummy logic




            Worksheets("Sheet1").Activate 'Go to Sheet1
            str = VBA.Split(Cells(i, 14)) 'Split the values by space. Then the values are stored as an Array for row i in column ORIG_PIO_STRING. These values will be compared to all the columns in the Sheet1.
                        'Cells(1, 20).Resize(1, UBound(str) + 1) = str 'Dummy to print the array variables




                For k = LBound(str) To UBound(str) 'loop through Array index k. Start from Lowerbound k = 0 to Upperbound k = nr of values in row i for column ORIG_PIO_STRING
                    Shortstr = Left(str(k), 4)
                    Worksheets("Sheet2").Activate 'Activate Sheet2
                    'lrow = Cells(Rows.Count, 1).End(xlUp).Row 'Not used, but can define last row for column A in Sheet 1


                        For m = 4 To 40 'Here one can use the lrow, or define how many rows that should be looked through in the Sheet2
                        ValLookup = ThisWorkbook.Worksheets("Sheet2").Cells(m, j).Value 'This value will be compared to the Array values.
                        ValLookupShort = ValLookup & "*"
                            If Shortstr Like ValLookup Then 'If index value (k) in array match a cell value from the column j in Sheet 1 then do:


                                If Shortstr Like ValLookup Then 'If index value (k) is equal to the value found in Sheet1 then replace that index value with "n//a"
                                str(k) = "n//a" 'Instead of removing the value from the Array, we override it with a dummy variable
                                RemoveVal = "n//a" 'Dummy variable to write the dummy word: n//a
                                End If


                                    Worksheets("Sheet1").Activate 'Activate Sheet1
                                    Range(Cells(i, 14), Cells(i, 14)) = Join(str, " ") 'Overwrite the old value in ORIG_PIO_STRING with the dummy variable
                                    'Range(Cells(i, 23), Cells(i, 23)) = Join(str, " ")
                                    'Range(Cells(i, 23), Cells(i, 23)).Value = RemoveVal 'Test for writing the dummy variable: n//a


                            End If


                        Next m


                Next k


        End If


    Next j


Next i


'The last part removes the dummy variable that has replaced all the values that should be removed in column ORIG_PIO_STRING
Worksheets("Sheet1").Activate 'Activate Sheet1
    Replace_Dummy_Variable_lastrow = Cells(Rows.Count, 14).End(xlUp).Row 'Find last row in column ORIG_PIO_STRING
    Range(Cells(2, 14), Cells(Replace_Dummy_Variable_lastrow, 14)).Select 'Define the range to replace the dummy variables
        Selection.Replace What:="n//a ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False 'Find all dummy variables "n//a " (including a space character) and replace it with nothing


End