CODEWITHSUNDEEP
excelvbareplace
Ross Nelson
Ross Nelson

Reputation: 13

VBA - Search a string for a value from an array and delete the value

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

I have 2 sheets of data (see attached); 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 column N 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. Sheet2 Dimensions are 12 Columns wide by 46 rows long.

The challenge I have is Columns 1 and 2 on Sheet 1 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. In the attachments below I've highlighted the values that should be removed.

Sheet1: Sheet1

Sheet2: Sheet2

In this example, Row 2 on Sheet 1 would be compared to Column A on Sheet 2 because Sheet1 D2=Sheet2 A1 and Sheet1 M2=Sheet2 A2. The result would be that on Row 2 RB5220 should be removed from the string on Sheet1. The same logic would be applied to Rows 3 & 4 on Sheet1. Rows 5-8 would receive no action.

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

As always, thank you in advance for your help.

I've been working on this for a bit and have not come up with a satisfactory solution as of yet. The only method I have so far invokes the autofilter function based on the criteria from sheet 2 and then a replace function for each item in the column. Not the most efficient way and it requires manual maintenance if the list were to change. Here is an example:

    With rng
    .AutoFilter Field:=4, Criteria1:="=*Tac*"
    .AutoFilter Field:=13, Criteria1:="=XX14*"
End With

'Replace JB with Blank in Column N
    Sheets("Acczn Results").Columns("N").Replace _
      What:="JB????", Replacement:="", _
      SearchOrder:=xlByColumns, MatchCase:=True

    'Replace AA with Blank in Column N
        Sheets("Acczn Results").Columns("N").Replace _
      What:="AA????", Replacement:="", _
      SearchOrder:=xlByColumns, MatchCase:=True

Final code: Acczn Results = Sheet1; Conflicts = Sheet2; Added Shortstr = Left(str(k), 4).

Dim LookupvalueA1 As String
Dim 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("Acczn Results").Cells(i, 4).Value 'Define the value in column SRES_NM to check againt in Sheet2, Row 1
LookupvalueB1 = ThisWorkbook.Worksheets("Acczn Results").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("Conflicts").Cells(1, j).Value 'For Sheet1 loop through row 1 for column j
LookupvalueB2 = ThisWorkbook.Worksheets("Conflicts").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("Acczn Results").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("Conflicts").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("Conflicts").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("Acczn Results").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("Acczn Results").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

Upvotes: 0

Views: 709

Answers (2)

Wizhi
Wizhi

Reputation: 6549

I think this should work for you, I tested :). This assumes that values in Sheet 2 become 4 letter instead of 6. (AC1000 -> AC10, AC1700 -> AC17 etc).

I modify the following parts of the code:

Shortstr = Left(str(k), 4) -> made comment instead of run code

Here is where we make the wildcard possible. Wildcard will not work when we trying to match for example "MC2000" from Sheet 1 with BLANK VALUES on sheet 2 (because we loop thru row m = 4 to 40). It will accept those values (say its true, i.e. "MC2000" = "Blank cell", is true..) and we don't want that. Therefore we only loop through the to the last row. So no empty cell is allowed in the middle of the column.

lrow = Cells(Rows.Count, j).End(xlUp).Row -> Activated code, was comment before

For m = 4 To 40 -> For m = 4 To lrow

ValLookupShort = ValLookup & "*" -> made comment instead of run code

If Shortstr Like ValLookup Then -> If str(k) Like ValLookup & "*" -Both places

Total code should look like: 

Dim LookupvalueA1 As String
Dim 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("Acczn Results").Cells(i, 4).Value 'Define the value in column SRES_NM to check againt in Sheet2, Row 1
LookupvalueB1 = ThisWorkbook.Worksheets("Acczn Results").Cells(i, 13).Value 'Define the value in column NEW_PIC to check againt in Sheet2, Row2
'LLAB1 = LookupvalueA1 & LookupvalueB1 'Dummy variable 1. 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("Conflicts").Cells(1, j).Value 'For Sheet1 loop through row 1 for column j
LookupvalueB2 = ThisWorkbook.Worksheets("Conflicts").Cells(2, j).Value 'For Sheet1 loop through row 2 for column j
'LLAB2 = LookupvalueA2 & LookupvalueB2 'Dummy variable 2. 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 variable 1 & 2 logic


        Worksheets("Acczn Results").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("Conflicts").Activate 'Activate Sheet2
                lrow = Cells(Rows.Count, j).End(xlUp).Row 'Not used, but can define last row for column "j", where j is between 1 and 12 in Sheet 1

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

                            If str(k) 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("Acczn Results").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("Acczn Results").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
End Sub

Upvotes: 0

Wizhi
Wizhi

Reputation: 6549

I think this could solve your problem. I have set up the code after your example. The worksheet name I have used are "Sheet1" and "Sheet2". So what does the code do?

  • It combine the values in column D and M for Sheet1.
  • Then search for that combination in Sheet 2 (Row 1 and 2) and locates which column the combination is found. When the combination is found it split the "words" in Sheet1, column N.
  • Then check all the values in the column previously found.
  • When Value is found it replaces it with n//a in Sheet1. Finally it replaces n//a with "nothing".

Code:

Sub FindAndRemoveValues()
Dim LookupvalueA1 As String
Dim LookupvalueB1 As String
Dim LookupvalueA2 As String
Dim LookupvalueB2 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
                    Worksheets("Sheet2").Activate 'Activate Sheet2
                    'lrow = Cells(Rows.Count, j).End(xlUp).Row 'Not used, but can define last row for column "j", where j is between 1 and 12 in Sheet 1

                        For m = 4 To 46 '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.

                            If str(k) = ValLookup Then 'If index value (k) in array match a cell value from the column j in Sheet 1 then do:

                                If str(k) = 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

End Sub

Upvotes: 0

Related Questions