Filter multiple columns in table - excel

My code filters one column then prints.
I need to filter based on two columns and then print. I.e. filter based on engineer name (column 1) and route (column 2). Right now, it filters on engineer name (column 1).
Option Explicit
Sub filterandprint()
Dim TempWks As Worksheet
Dim wks As Worksheet
Dim myRng As Range
Dim myCell As Range
'change to match your worksheet name
Set wks = Worksheets("Table")
Set TempWks = Worksheets.Add 'creates temporary worksheet
wks.AutoFilterMode = False 'remove the arrows
'assumes headers only in row 1, columns(1) will be the number of the column you base your filtering
'this copies the unique filtering and pastes it on a new temp worksheet
wks.Columns(1).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=TempWks.Range("A1"), Unique:=True
With TempWks
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With
'looping
With wks
For Each myCell In myRng.Cells
.UsedRange.AutoFilter Field:=1, Criteria1:=myCell.Value
'.UsedRange.AutoFilter Field:=2, Criteria1:=myCell.Value
.PrintOut Preview:=True
Next myCell
End With
Application.DisplayAlerts = False
TempWks.Delete 'deletes temporary worksheet
Application.DisplayAlerts = True
End Sub

For anyone else searching for an answer, edited the above looping section to the below and it worked:
...
Dim iLoop As Integer
'looping
With wks
For iLoop = 2 To 65
.UsedRange.AutoFilter Field:=1, Criteria1:=TempWks.Cells(iLoop, 1).Value
.UsedRange.AutoFilter Field:=2, Criteria1:=TempWks.Cells(iLoop, 2).Value
.PrintOut Preview:=True
Next iLoop
End With
Application.DisplayAlerts = False
TempWks.Delete 'deletes temporary worksheet
Application.DisplayAlerts = True
End Sub

Related

VBA Macro to Autofilter One Date and Special Cells Delete

I am modifying this code, Macro - delete rows based on date.
Sub DeleteDateWithAutoFilter()
Dim MySheet As Worksheet, MyRange As Range
Dim LastRow As Long, LastCol As Long
'turn off alerts
Application.DisplayAlerts = False
'set references up-front
Set MySheet = ThisWorkbook.Worksheets("Sheet3")
'identify the last row in column A and the last col in row 1
'then assign a range to contain the full data "block"
With MySheet
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
LastCol = .Range("A" & .Columns.Count).End(xlToLeft).Column
Set MyRange = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With
'apply autofilter to the range showing only dates
'older than january 1st, 2013, then deleting
'all the visible rows except the header
With MyRange
.AutoFilter Field:=1, Criteria1:="<8/5/2021"
.SpecialCells(xlCellTypeVisible).Offset(1, 0).Resize(.Rows.Count).Rows.Delete
End With
'turn off autofilter safely
With MySheet
.AutoFilterMode = False
If .FilterMode = True Then
.ShowAllData
End If
End With
'turn alerts back on
Application.DisplayAlerts = True
End Sub
So far I have added an input box where the user can define the date they are looking for. This is working great.
Sub EditedCode()
Dim MySheet As Worksheet, MyRange As Range
Dim LastRow As Long, LastCol As Long
Dim myValue As String
'turn off alerts
Application.DisplayAlerts = False
'set references up-front
Set MySheet = ThisWorkbook.Worksheets("Sheet13")
myValue = InputBox("Enter Date in XX/XX/XXXX Format", "Date Selection", " ")
Range("Y1") = myValue
From here I want to autofilter just the input date to then use .SpecialCells to delete everything but the selected date. I've tried using criteria1/Operator/Criteria2 but I cannot get this to work. Anyone know what I am doing wrong?
Current Full Code:
Sub EditedCode()
Dim MySheet As Worksheet, MyRange As Range
Dim LastRow As Long, LastCol As Long
Dim myValue As String
'turn off alerts
Application.DisplayAlerts = False
'set references up-front
Set MySheet = ThisWorkbook.Worksheets("Sheet13")
myValue = InputBox("Enter Date in XX/XX/XXXX Format", "Date Selection", " ")
Range("Y1") = myValue
'identify the last row in column A and the last col in row 1
'then assign a range to contain the full data "block"
With MySheet
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
LastCol = .Range("A" & .Columns.Count).End(xlToLeft).Column
Set MyRange = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With
'apply autofilter to the range showing only dates using above input
'older than inputed date, then deleting
'all the visible rows except the header
With MyRange
.AutoFilter Field:=1, Criteria1:="=& myValue"
.SpecialCells(xlCellTypeVisible).Offset(1, 0).Resize(.Rows.Count).Rows.Delete
End With
'turn off autofilter safely
With MySheet
.AutoFilterMode = False
If .FilterMode = True Then
.ShowAllData
End If
End With
'turn alerts back on
Application.DisplayAlerts = True
End Sub
I have also tried changing the type of myValue and using different funtions on autofilter (<,>,=). Any help is appreciated. Thank you!
Example of ws

Unique (Filter) Values Not Copying on Summary Sheet

I am using the code below to copy data tables from several sheets. I noticed that I am missing a column on the "Summary" sheet. This column is developed on the other sheets using a unique filter =UNIQUE(FILTER(L:L,L:L<>"")). The ActiveSheet.Paste function works to copy unique filters, but I cannot get it to work with my code. Any advice?
Sub Summary()
Dim wkstDst As Worksheet
Dim wkstSrc As Worksheet
Dim rngSrc As Range
LastRow = Range("A500").End(xlUp).Row
Set wkstDst = ThisWorkbook.Worksheets("Summary")
wkstDst.Select
Range("A9", Cells(LastRow, "F")).ClearContents
For Each wkstSrc In ThisWorkbook.Worksheets
If wkstSrc.Name <> "Summary" Then
With wkstSrc
Set rngSrc = .Range(.Cells(11, 2), .Cells(.Rows.Count, 2).End(xlUp)).Resize(, 5)
With rngSrc
.AutoFilter Field:=1, Criteria1:="<>#N/A"
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=wkstDst.Cells(Rows.Count, 1).End(xlUp)(2)
.AutoFilter
End With
End With
End If
Next wkstSrc
End Sub

Delete Filtered Rows

Overview:
I have 2 macros, one filters the data and the second deletes the visible rows below the header rows (header rows 1-12).
2 Questions:
1) How do I best combine these into a single macro?
2) How do I get the second one to work properly?
I receive the
Run Time Error 1004: Method 'Range' of object '_worksheet' failed
on the Delete() macro line:
Set rng = .Range("A12:A" & LastRow).SpecialCells(xlCellTypeVisible)
I have also tried:
Set rng = .Range("A12:A" & LastRow).SpecialCells(xlCellTypeVisible).cells
Sub Filter()
'filter and delete rows that have AW as FALSE
For Each sht In ThisWorkbook.Worksheets
sht.Range("A12:AW12").autofilter Field:=49, Criteria1:="FALSE"
Next sht
End Sub
Sub Delete()
Dim sht As Worksheet, rng As Range, lastRow As Long
Set sht = Worksheets("Sheet1")
With sht
lastRow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A12:A" & LastRow).SpecialCells(xlCellTypeVisible)
rng.EntireRow.Delete
.AutoFilterMode = False
End With
End Sub
Sub Filter()
'filter and delete rows that have AW as FALSE
Dim rng As Range
For Each sht In ThisWorkbook.Worksheets
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
sht.Range("A1:O1").AutoFilter Field:=9, Criteria1:="FALSE"
sht.Range("A2:A" & LastRow).Delete
If sht.AutoFilterMode Then
sht.AutoFilterMode = False
End If
Next sht
End Sub
This is a working code for anyone that might find this going forward.
Sub Filter23()
'filter and delete rows that have AW as FALSE (working)
Dim sht As Worksheet, rng As Range, lastRow As Long
For Each sht In ThisWorkbook.Worksheets
sht.Range("A12:AW12").autofilter Field:=49, Criteria1:="FALSE"
With sht
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sht.Range("A12:A" & lastRow).SpecialCells(xlCellTypeVisible)
rng.EntireRow.Delete
End With
Next sht
End Sub

Filter then copy and paste values to new Excel tab

I'm trying to use an autofilter to filter unique values, then copy and paste these values to a new Excel tab.
The macro stops working at this line of code.
Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("CA1"), Unique:=True
Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String
'specify sheet name in which the data is stored
sht = "data"
'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:AY" & last)
'set last column
Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("CA1"), Unique:=True
For Each x In Range([CA2], Cells(Rows.Count, "CA").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=1, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
ActiveSheet.Paste
ActiveSheet.Range("A1").Select
ActiveSheet.Columns("A:A").Select
Selection.ColumnWidth = 15
End With
Next x
' Turn off filter
Sheets(sht).AutoFilterMode = False
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
In my opinion i think:
You are missing an End Sub at the end of your code.
CopyToRange:=Range("CA1"), you dont mention the sheet name just the range.
it is Working !!
Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String
'specify sheet name in which the data is stored
sht = "data"
'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:AY" & last)
'set last column
Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("CA1"), Unique:=True
End Sub

How to write a macro to filter a column and take out the required value?

I need a macro that need to filter a column and to take out the required date value along with the cell position (i.e say "4/22/2018" cell position "A9 or just 9"). Kindly help me out to fix this issue
See the code that I wrote below
Dim Date As String
Date = Sheets("alldata")
Rows("3:3").Select.AutoFilter.Range("$A$3:$AA$606").AutoFilter , Field:=1, Criterial:="#VALUE!"
Range("A3").Select.xlFilterValues.offset(1, 0).Copy.value
Sheets("Log").Cells(2, "AF").value = Date
Is this what you are trying?
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("alldata")
With ws
Set rng = .Range("$A$3:$A$606")
'~~> Remove any filters
.AutoFilterMode = False
With rng
.AutoFilter Field:=1, Criteria1:="<>#VALUE!"
'~~> Get the Row Number
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Row
'~~> Get The cell Address
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Address
'~~> Get the Date
Sheets("Log").Cells(2, "AF").Value = _
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Value
End With
'~~> Remove any filters
.AutoFilterMode = False
End With
End Sub
The following will filter the dates and for each date it will copy the value into Sheet Log in Column AF:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("alldata")
Dim wsLog As Worksheet: Set wsLog = Sheets("Log")
'declare and set your worksheet, amend as required
Dim LastRow As Long, LogLastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Dim c As Range, rng As Range
ws.Rows("3:3").AutoFilter
ws.Range("$A$3:$AA$" & LastRow).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(0, "01/01/2018")
Set rng = ws.Range("$A$4:$A$" & LastRow).SpecialCells(xlCellTypeVisible)
For Each c In rng
LogLastRow = wsLog.Cells(wsLog.Rows.Count, "AF").End(xlUp).Row
c.Copy Destination:=wsLog.Cells(LogLastRow, "AF")
'if instead of copying the value, you want to return its address,
'you can get the address by using "c.Address" for each value in the range
Next c
End Sub

Resources