Help with my macro

[stevestr]

My macro below needs some tweaking. The macro applies a filter and then
prints two copies of the sheet. My mistake is here:


If Range("D6").Value = "EDTAP: RLSS" Then
'call macro here

After the filter is applied, the first five rows is header information. I
wanted the Macro to look at the first row of filtered information for "EDTAP:
RLSS". What I didn't realize when writing this macro that the 6th row of my
data may not contain "EDTAP: RLSS". Instead the first row of filtered data
may have "EDTAP: RLSS" on the 13th row. If so, my macro does not print the
filtered data.

What I needed to do was to program the macro to look at the 6th line of data
after the filter has been applied, not row 6. How do I get the macro to do
just that?

Thanks,


************************************





Goes to Mileage form, applies filter
'
'
Sheets("Mileage and Expense Form").Select

ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=4, Criteria1:= _
"=EDTAP: RLSS", Operator:=xlOr, Criteria2:="="

' ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=4,
Criteria1:= _
"EDTAP: RLSS"

'
'
' Prints two copies of Filtered sheet.
'


If Range("D6").Value = "EDTAP: RLSS" Then
'call macro here

ExecuteExcel4Macro "PRINT(1,,,2,,,,,,,,2,,,TRUE,,FALSE)"
End If


'
' ExecuteExcel4Macro "PRINT(1,,,2,,,,,,,,2,,,TRUE,,FALSE)"
'
'

 

[Dave Peterson]

It looks like you want to check to see if the filter returned any visible data.
If it did, then print it.

Am I close?

If I am, then this worked ok for me in xl2003.

Option Explicit
Sub testme02()

Dim wks As Worksheet

Set wks = Worksheets("Mileage and Expense Form")

Application.Goto wks.Range("A1") 'move activecell outside that listobject!

wks.ListObjects(1).Range.AutoFilter field:=4, _
Criteria1:="EDTA3P: RLSS"

If wks.ListObjects(1).Range.Columns(1) _
.Cells.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
MsgBox "only headers are visible"
Else
wks.PrintOut preview:=True
End If

End Sub

I used .listobjects(1), so you'll have to edit the code a bit.

 

[OssieMac]

Hi,

Do I understand that you want to test the first visible cell of data in the
filtered range in column D? If so, then the following should do it. By way of
explanation, you cannot count rows in non contiguous rows of filtered data.
However, you can set a range variable to the visible cells and test the first
cell of the range.

Firstly need to establish that more than the header row is visible. (Setting
criteria by code can result in no actual data visible). Therefore set the
filtered range of one column to a range variable and test the count of cells.
(More than one cell means more than the header row.) If more than header row
then set the range to only include the data and exclude the header. I'll
explain the following line of code. Note that a space an underscore is a line
break in an otherwise single line of code.

Set rngCol4Visible = .Columns(4) _
.Offset(1, 0) _
.Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)

..Columns(4) Sets it to column 4
..Offset(1, 0) Move entire range down one row off the header. This then
includes an extra line at the bottom.
..Resize(.Rows.Count - 1, 1) Remove the extra line at the bottom.
Up to this point the range contains both visible and non visible cells.
..SpecialCells(xlCellTypeVisible) Only include visible cells.

Following example of code.

Sub test()
Dim rngCol4Visible As Range
Dim temp

ActiveSheet.ListObjects("Table2") _
.Range.AutoFilter Field:=4, Criteria1:= _
"EDTAP: RLSS"

With ActiveSheet.ListObjects("Table2") _
.AutoFilter.Range

'Following includes the column header
Set rngCol4Visible = .Columns(4) _
.SpecialCells(xlCellTypeVisible)

If rngCol4Visible.Cells.Count > 1 Then
'More than header is visible
'Set to data only excluding header
Set rngCol4Visible = .Columns(4) _
.Offset(1, 0) _
.Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)

'Test value of first cell in range
If rngCol4Visible.Cells(1, 1) = "EDTAP: RLSS" Then
'Your code here
End If

Else
MsgBox "Only Headers visible. No Data visible"
End If
End With

End Sub

 

[JLatham]

Probably someone will come up with a more elegant solution, but this appears
to work. Drop the whole thing into your workbook and test it with some
filtered data and see if it looks like it does what you need. If it does,
you should be able to adapt it to do something like
If Range("D" & rowIWant).Value = "EDTAP: RLSS" Then
as I've shown it in the code and put the code that should be executed within
that If...Then block.



Sub TestIt()
Dim colDEntries As Range
Dim anyTestCell As Range
Dim notHiddenCount As Integer
Dim rowIWant As Long

Set colDEntries = Range("D1:" & _
Range("D" & Rows.Count).End(xlUp).Address)
For Each anyTestCell In colDEntries
If anyTestCell.EntireRow.Hidden = False Then
notHiddenCount = notHiddenCount + 1
If notHiddenCount = 6 Then
rowIWant = anyTestCell.Row
Exit For
End If
End If
Next
'could be that there were not 6
'rows left to display, so test for that
If notHiddenCount = 6 Then
If Range("D" & rowIWant) = "EDTAP: RLSS" Then
MsgBox "Found at now visible row: " & rowIWant
End If
End If
End Sub

 

[stevestr]

Dave,

You're close but I need some more help. Can I send you a copy of the
spreadsheet?

Steve

 

[Dave Peterson]

No thanks to the file.

If you want to post them on a file sharing site like http://www.senduit.com,
then maybe someone will download your file and help.

There are lots of people will open files from others, but I'm not one of them.

If no one offers any help, you can still describe the problem in plain text in
this forum.

 

[stevestr]

Dave,

Good counsel to a novice. Practice safe computing.

The macro I posted earlier is little more than recording keystrokes and
mouse clicks with a few changes once the macro was recorded. Your solution
was elegant and above my pay grade. Since I'm not a programmer, I had some
trouble once I put the macro into my spreadsheet.

Your posted solution: (My questions are between the ******)

Sub Macro2()
Dim wks As Worksheet

Set wks = Worksheets("Mileage and Expense Form")

Application.Goto wks.Range("A1") 'move activecell outside that listobject!

wks.ListObjects(1).Range.AutoFilter field:=4, _
Criteria1:="EDTAP: RLSS", Operator:=xlOr, Criteria2:="="

**************************************************
' I added the "Operator:=xlOr, Criteria2:="=" to your expression above in
order to to show the signature lines below the spreadsheet. Did I do this
correctly?
*****************************************************


If wks.ListObjects(1).Range.Columns(1) _
.Cells.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
MsgBox "only headers are visible"
Else
Range("A1:I1").Select
ActiveCell.FormulaR1C1 = "REQUEST FOR REIMBURSEMENT OF EDTAP EXPENSES"
wks.PrintOut preview:=True
End If


************************
If there are entries that meet the selection criteria, I want the macro to
change row one to read "REQUEST FOR REIMBURSEMENT OF EDTAP EXPENSES" and
print two copies.

Once the two copies are printed, the macro should remove the filter, change
row 1 to read ""REQUEST FOR REIMBURSEMENT OF TRAVEL AND JOB RELATED
EXPENSES" and print one copy of the unfiltered sheet.

Filters the date in column 4 for EDTAP: RLSS and Blank Rows
' If the spreadsheet returns EDTAP entries, change Row 1 to read "REQUEST
FOR REIMBURSEMENT OF EDTAP EXPENSES"
' Then print two copies of the filtered sheet
' Then change Row 1 to read "REQUEST FOR REIMBURSEMENT OF TRAVEL AND JOB
RELATED EXPENSES"
'Then remove the filter and print one copy of the unfiltered sheet

I will post my macro below in hopes you can help correct it.

Thanks,

Steve

My Macro***********************************

' Sub Macro2()
'
'
' Goes to Mileage form, applies filter
'
'
' Sheets("Mileage and Expense Form").Select

' ActiveSheet.ListObjects("Table2").Range.AutoFilter field:=4,
Criteria1:= _
' "=EDTAP: RLSS", Operator:=xlOr, Criteria2:="="

' ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=4,
Criteria1:= _
' "EDTAP: RLSS"

'
'
' Prints two copies of Filtered sheet.
'





'Option Explicit
Sub Macro2()
' Filters the date in column 4 for EDTAP: RLSS and Blank Rows
' If the spreadsheet returns EDTAP entries, change Row 1 to read "REQUEST
FOR REIMBURSEMENT OF EDTAP EXPENSES"
' Then print two copies of the filtered sheet
' Then change Row 1 to read "REQUEST FOR REIMBURSEMENT OF TRAVEL AND JOB
RELATED EXPENSES"
'Then remove the filter and print one copy of the unfiltered sheet

Dim wks As Worksheet

Set wks = Worksheets("Mileage and Expense Form")

Application.Goto wks.Range("A1") 'move activecell outside that listobject!

wks.ListObjects(1).Range.AutoFilter field:=4, _
Criteria1:="EDTAP: RLSS", Operator:=xlOr, Criteria2:="="

If wks.ListObjects(1).Range.Columns(1) _
.Cells.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
MsgBox "only headers are visible"
Else
Range("A1:I1").Select
ActiveCell.FormulaR1C1 = "REQUEST FOR REIMBURSEMENT OF EDTAP EXPENSES"
wks.PrintOut preview:=True
End If

'End Sub


'If Range("D6").Value = "EDTAP: RLSS" Then
'call macro here

' Sheets("Mileage and Expense Form").Select
' Range("A1:I1").Select
' ActiveCell.FormulaR1C1 = "REQUEST FOR REIMBURSEMENT OF EDTAP EXPENSES"

' ExecuteExcel4Macro "PRINT(1,,,2,,,,,,,,2,,,TRUE,,FALSE)"

' Range("A1:I1").Select
'ActiveCell.FormulaR1C1 = _
' "REQUEST FOR REIMBURSEMENT OF TRAVEL AND JOB RELATED EXPENSES"

'End If


'
' ExecuteExcel4Macro "PRINT(1,,,2,,,,,,,,2,,,TRUE,,FALSE)"
'
'

'Removes filter from Mileage form
ActiveSheet.ListObjects("Table2").Range.AutoFilter field:=4

Sheets("Mileage and Expense Form").Select
ActiveSheet.ListObjects("Table2").Range.AutoFilter field:=2, Criteria1:= _
"<>"

ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"

ActiveSheet.ListObjects("Table2").Range.AutoFilter field:=2








'Sub RefreshData()
'
' RefreshData Macro

ActiveWorkbook.RefreshAll

'Sub PrintAllSheets()
'
' PrintAllSheets Macro


'
' Macro4 Macro
' Goes to Coversheet, refreshes data and widens columns, and print one copy
of the coversheet
'
'
Sheets("Cover Sheet").Select
ActiveWorkbook.RefreshAll

'ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh

'ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh

'ActiveSheet.PivotTables("PivotTable5").PivotCache.Refresh

Columns("F:F").ColumnWidth = 22.25
Columns("H:H").ColumnWidth = 14.25
Columns("I:I").ColumnWidth = 13.25


ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"


End Sub

End My Macro***********************************************

 

[Dave Peterson]

I think that this does what you want.

Option Explicit
Sub test2()
Dim wks As Worksheet
Dim myStr As String

Set wks = Worksheets("Mileage and Expense Form")

myStr = "EDTAP: RLSS"

With wks

Application.Goto .Range("A1")

If Application.CountIf(.ListObjects(1).Range.Columns(4), myStr) _
= 0 Then
MsgBox myStr & " not found!"
Exit Sub
End If

.ListObjects(1).Range.AutoFilter field:=4, _
Criteria1:=myStr, _
Operator:=xlOr, _
Criteria2:="="

.Range("A1").Value _
= "REQUEST FOR REIMBURSEMENT OF EDTAP EXPENSES"
.PrintOut preview:=False, copies:=2

.ListObjects(1).Range.AutoFilter

.Range("A1").Value _
= "REQUEST FOR REIMBURSEMENT OF TRAVEL AND JOB RELATED EXPENSES"
.PrintOut preview:=False

End With

End Sub

 

[stevestr]

Dave,

Thanks so much. The macro worked exactly as predicted!

Steve