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
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