arraysexcelvbaautofiltercross-reference

Condense two seperate arrays into one


The two scripts are working as intended, it basically takes a column of strings, filters certain phrases and then using .offset it renames a cell's contents. In this case the script looks at a list of Phones and Tablets and looks for things like 4G, 5G, and Cell to determine the difference.

Only problem is that there's two columns I need to perform the check on the same row, if column G matches true and column P matches false, there's a confict and it messes up the accuracy of the returned data. Which ever script runs last overwrites the .offset and has last say.

Data is stored to this variable:
arrResult

My intention is to merge the same script under one, check both G and P together, then filter them out under the same arrResult.

Sub FilterOut()

'Under column G, look for all ipads and samsungs that don't have 4g, 5g, and cell and name them Tablets
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Full Asset List")

Dim lastRow As Long
lastRow = ws.Range("G" & ws.Rows.Count).End(xlUp).Row

Dim arr(): Dim arrResult()
Dim rg As Range: Dim i As Long

Set rg = ws.Range("G1:G" & lastRow)
arr = Application.Transpose(rg)

For i = LBound(arr) To UBound(arr)
    If InStr(arr(i), "SAMSUNG TABLET") <> 0 Or InStr(arr(i), "IPAD") <> 0 Or InStr(arr(i), "ipad") <> 0 Then
        If InStr(arr(i), "64GB") <> 0 Then arr(i) = Replace(arr(i), "64GB", "!@!")
            If InStr(arr(i), "*CELL*") = 0 And InStr(arr(i), "*cell*") = 0 And InStr(arr(i), "4G") = 0 And InStr(arr(i), "5G") = 0 Then
                If InStr(arr(i), "!@!") <> 0 Then arr(i) = Replace(arr(i), "!@!", "64GB")
                j = j + 1
                ReDim Preserve arrResult(1 To j)
                arrResult(j) = arr(i)
            End If
    End If
Next i

With rg
    .AutoFilter field:=1, criteria1:=arrResult, Operator:=xlFilterValues
    .Resize(.Rows.Count - 1, 1).Offset(1, -2).Value = "Tablet"
    .Resize(.Rows.Count - 1, 1).Offset(1, -3).Value = "Tablet"
End With

    ws.AutoFilterMode = False

End Sub
Sub FilterOut2()

'Under column P, look for all ipads and samsungs that don't have 4g, 5g, and cell and name them Tablets
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Full Asset List")

Dim lastRow As Long
lastRow = ws.Range("P" & ws.Rows.Count).End(xlUp).Row

Dim arr(): Dim arrResult()
Dim rg As Range: Dim i As Long

Set rg = ws.Range("P1:P" & lastRow)
arr = Application.Transpose(rg)

For i = LBound(arr) To UBound(arr)
    If InStr(arr(i), "IPAD") <> 0 Or InStr(arr(i), "ipad") <> 0 Then
        If InStr(arr(i), "64GB") <> 0 Then arr(i) = Replace(arr(i), "64GB", "!@!")
            If InStr(arr(i), "CELL") = 0 And InStr(arr(i), "cell") = 0 And InStr(arr(i), "4G") = 0 And InStr(arr(i), "5G") = 0 Then
                If InStr(arr(i), "!@!") <> 0 Then arr(i) = Replace(arr(i), "!@!", "64GB")
                j = j + 1
                ReDim Preserve arrResult(1 To j)
                arrResult(j) = arr(i)
            End If
    End If
Next i

With rg
    .AutoFilter field:=1, criteria1:=arrResult, Operator:=xlFilterValues
    .Resize(.Rows.Count - 1, 1).Offset(1, -11).Value = "Tablet"
    .Resize(.Rows.Count - 1, 1).Offset(1, -12).Value = "Tablet"
End With

    ws.AutoFilterMode = False

End Sub

I have tried to select two ranges but autofilter doesn't like that, I tried to run the whole script under a loop for each column but again the problem of having last say shows up.

Edit Here's my attempt at changing:

Error: Object Variable or with block variable not set

.AutoFilter field:=1, criteria1:=arrResult, Operator:=xlFilterValues
Sub FilterOut3()

Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Full Asset List")

Dim lastRow As Long
lastRow = ws.Range("P" & ws.Rows.Count).End(xlUp).Row

Dim arr(): Dim arrResult()
Dim rg As Range: Dim i As Long

arr = ws.Range("G1:P" & lastRow).Value

'arr = Application.Transpose(rg)

For i = LBound(arr) To UBound(arr)
    If InStr(arr(i, 1), "IPAD") <> 0 Or InStr(arr(i, 1), "ipad") <> 0 Then
        If InStr(arr(i, 1), "64GB") <> 0 Then arr(i, 1) = Replace(arr(i, 1), "64GB", "!@!")
            If InStr(arr(i, 1), "CELL") = 0 And InStr(arr(i, 1), "cell") = 0 And InStr(arr(i, 1), "4G") = 0 And InStr(arr(i, 1), "5G") = 0 Then
                If InStr(arr(i, 1), "!@!") <> 0 Then arr(i, 1) = Replace(arr(i, 1), "!@!", "64GB")
                j = j + 1
                ReDim Preserve arrResult(1 To j)
                arrResult(j) = arr(i, 1)
            End If
    End If
Next i

With rg
    .AutoFilter field:=1, criteria1:=arrResult, Operator:=xlFilterValues
    .Resize(.Rows.Count - 1, 1).Offset(1, -11).Value = "Tablet"
    .Resize(.Rows.Count - 1, 1).Offset(1, -12).Value = "Tablet"
End With

    ws.AutoFilterMode = False

End Sub

Solution

  • The below combines both codes, I also simplified the If structure a lot and removed the "64GB" replacement because it's not achieving anything.

    Sub FilterOut_Combined()
    
    'Look for all ipads and samsungs that don't have 4g, 5g, and cell in column P or G and name them Tablets
    
    Dim ws As Worksheet: Set ws = ActiveWorkbook.Sheets("Full Asset List")
    Dim lastRow As Long, lRow2 As Long
    lastRow = ws.Range("P" & ws.Rows.Count).End(xlUp).Row
    lRow2 = ws.Range("G" & ws.Rows.count).End(xlUp).Row
    If lRow2 > lastRow Then lastRow = lRow2 'use whichever is bigger
    
    Dim arrP(), arrG(), arrResult()
    Dim rgP As Range, rgG as Range, i As Long
    
    Set rgP = ws.Range("P1:P" & lastRow): Set rgG = ws.Range("G1:G" & lastRow)
    arrP = Application.Transpose(rgP): arrG = Application.Transpose(rgG)
    
    For i = LBound(arrP) To UBound(arrP)
        If (LCase(arrP(i)) Like "*ipad*" Or LCase(arrG(i)) Like "*ipad*") And _
            Not (LCase(arrP(i)) Like "*cell*" Or LCase(arrG(i)) Like "*cell*" Or arrP(i) Like "*4G*" Or arrG(i) Like "*4G*" Or arrP(i) Like "*5G*" Or arrG(i) Like "*5G*") _
            Then
                j = j + 1
                ReDim Preserve arrResult(1 to j)
                arrResult(j) = arrP(i) ' just using P for the filtering
        End If
    Next i
    
    With rgP
        .AutoFilter field:=1, criteria1:=arrResult, Operator:=xlFilterValues
        .Resize(.Rows.Count - 1, 1).Offset(1, -11).Value = "Tablet"
        .Resize(.Rows.Count - 1, 1).Offset(1, -12).Value = "Tablet"
    End With
    
        ws.AutoFilterMode = False
    
    End Sub