VBA code filtering a column then filling a formula for visible cells in another column
I am new to macros, but I am trying to filter the AW column and then enter text that matches those criteria in the AZ column. Of course, I would like to fill this text with visible cells and then repeat the process using other criteria filtered in the AZ column. I'm using the below encoding, but it doesn't populate the AZ column, only in AZ2! I don't want the headlines to suffer. Appreciate any help here! -Amy
Sub Macro16()
' Macro16 Macro
'Insert Column - OK
Columns("AZ:AZ").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AZ1").Select
ActiveCell.FormulaR1C1 = "Finalized Comment"
Rows("1:1").Select
Range("AS1").Activate
Selection.AutoFilter
'Filter Combined Comment for #NA then type "Style linked to a Dropped T/P"
Dim lastRow As Long
With ActiveSheet
.Range("AW2").AutoFilter Field:=2, Criteria1:="#N/A"
lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
.Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
SpecialCells(xlCellTypeVisible).Value = _
"Style Linked to a Dropped T/P"
End With
'Filter Combined Comment for "Confirmed Cost and Missing HTS Code" then =Combined Comment
Dim lastRow As Long
With ActiveSheet
.Range("AW2").AutoFilter Field:=2, Criteria1:="Confirmed Cost and Missing HTS Code"
lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
.Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
SpecialCells(xlCellTypeVisible).Value = _
"Confirmed Cost and Missing HTS Code"
End With
'Filter Combined Comment for "Unconfirmed Cost and HTS Code Present" then =Unconfirmed Cost
Dim lastRow As Long
With ActiveSheet
.Range("AW2").AutoFilter Field:=2, Criteria1:="Unconfirmed Cost and HTS Code Present"
lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
.Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
SpecialCells(xlCellTypeVisible).Value = _
"Unconfirmed Cost"
End With
'Filter Combined Comment for "Unconfirmed Cost and Missing HTS Code" then =Missing HTS
Dim lastRow As Long
With ActiveSheet
.Range("AW2").AutoFilter Field:=2, Criteria1:="Unconfirmed Cost and Missing HTS Code"
lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
.Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
SpecialCells(xlCellTypeVisible).Value = _
"Missing HTS Code"
End With
End Sub
source to share
Sub Tester()
Dim lastRow As Long
With ActiveSheet
.Range("AW2").AutoFilter Field:=2, Criteria1:="Test"
lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
.Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
SpecialCells(xlCellTypeVisible).Value = _
"Style Linked to a Dropped T/P"
End With
End Sub
EDIT: Updated and slightly reworked ...
Sub Macro16()
Dim lastRow As Long
'Insert Column - OK
ActiveSheet.Columns("AZ:AZ").Insert Shift:=xlToRight, _
CopyOrigin:=xlFormatFromLeftOrAbove
Range("AZ1").Value = "Finalized Comment"
TagRows "#N/A", "Style Linked to a Dropped T/P"
TagRows "Confirmed Cost and Missing HTS Code", _
"Confirmed Cost and Missing HTS Code"
TagRows "Unconfirmed Cost and HTS Code Present", "Unconfirmed Cost"
TagRows "Unconfirmed Cost and Missing HTS Code", "Missing HTS Code"
End Sub
Sub TagRows(TextToFind As String, TagWithText As String)
Dim lastRow As Long
With ActiveSheet
'filter the column for "TextToFind"
.Range("AW:AW").AutoFilter Field:=1, Criteria1:=TextToFind
'find the last row
lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
'if any visible rows, fill in the new comment "TagWithText"
If lastRow > 2 Then
.Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
SpecialCells(xlCellTypeVisible).Value = TagWithText
End If
.Range("AW:AW").AutoFilter Field:=1 'clear the filter
End With
End Sub
source to share
Decomposition of the Range.AutoFilter Method and processing strictly within in-memory arrays should speed up this process.
Option Explicit
Sub tagAZ()
Dim t As Variant, vFNDs As Variant, vTAGs As Variant
Dim a As Long, vAWs As Variant, vAZs As Variant
appTGGL bTGGL:=False
vFNDs = Array("#N/A", "Confirmed Cost and Missing HTS Code", _
"Unconfirmed Cost and HTS Code Present", _
"Unconfirmed Cost and Missing HTS Code")
vTAGs = Array("Style Linked to a Dropped T/P", "Confirmed Cost and Missing HTS Code", _
"Unconfirmed Cost", "Missing HTS Code")
With Worksheets("Sheet1")
.Columns(52).Insert
.Cells(1, 52) = "tag comment"
.Columns(52).ColumnWidth = 32
With .Range(.Cells(2, 49), .Cells(Rows.Count, 49).End(xlUp))
vAWs = .Cells.Value2
ReDim vAZs(LBound(vAWs, 1) To UBound(vAWs, 1), 1 To 1)
For a = LBound(vAWs, 1) To UBound(vAWs, 1)
Select Case True
'catch True errors
Case IsError(vAWs(a, 1))
If vAWs(a, 1) = CVErr(xlErrNA) Then _
vAZs(a, 1) = vTAGs(0)
'catch text-that-looks-like-an-error
Case vAWs(a, 1) = vFNDs(0)
vAZs(a, 1) = vTAGs(0)
'catch the rest
Case vAWs(a, 1) = vFNDs(1)
vAZs(a, 1) = vTAGs(1)
Case vAWs(a, 1) = vFNDs(2)
vAZs(a, 1) = vTAGs(2)
Case vAWs(a, 1) = vFNDs(3)
vAZs(a, 1) = vTAGs(3)
End Select
Next a
End With
'return processed tag comments to the worksheet
.Cells(2, 52).Resize(UBound(vAZs, 1), UBound(vAZs, 2)) = vAZs
End With
appTGGL
End Sub
Public Sub appTGGL(Optional bTGGL As Boolean = True)
Debug.Print Timer
With Application
.ScreenUpdating = bTGGL
.EnableEvents = bTGGL
.DisplayAlerts = bTGGL
.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
End With
End Sub
Elapsed time for 250K rows of random data where 75% of the values in column AW will match: 2.06 seconds.It takes 24.25 seconds to execute the same data using the coded equivalent of the AutoFilter Method (with the same environment properties disabled).
source to share