I'm working on summarizing a reconsillation statement. My code is supposed
to apply an autofilter based on fixed criteria. That part works. Next it
should insert formulas into the filtered/visible cells to create in-line
subtotals. The formulas are inserted into Columns "I" and "J" of the visble
rows. I haven't figured out how to accomplish this feat. (I've labeled
custom subroutines) My code is as follows:

Sub AutoFilterAndSummarize()
'Macro for Step II of Air Travel Bill Processor. This module condenses
the entries by KEY,
'enabling each transaction to appear as a single line in the datafile.
Dim StartTargetRange As Range
Dim EndTargetRange As Range
Dim x As Integer

'Disable Sheet Protection and select entire dataset
ShieldsDown 'Custom Subroutine to disable protection
Workbooks("Travel.xls").Activate
SelectCurrentRegion 'Custom Subroutine to select current data set

'Isolate Valid Records as a Cautionary Measure.
'Technically no invalid records should remain when this step is run.
'But this code will allow availible information to be summarized.
Selection.AutoFilter Field:=13, Criteria1:="=||*", Operator:=xlAnd
Selection.Subtotal GroupBy:=13, Function:=xlSum, TotalList:=Array(8), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

'Insert blank columns for Service Fee and Transaction Total columns
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight

Dim Visibility As Range, RowState As String, i As Integer
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row

<<<PROBLEM LOOP!!! INSERT FORMULAS & CAPTURE 1ST & LAST ROW VALUES OF
FILTERED/VISIBLE DATA
'ReDim RowState(1 To ActiveSheet.UsedRange.Rows.Count)
x = 0
i = -1
For Each RowState In ActiveSheet.AutoFilter.Range.Rows
i = i + 1
If RowState.EntireRow.Hidden = False Then
RowState.Cells(i, 9).Activate
ActiveCell.FormulaR1C1 = "=IF(RC[-5]=""ARC Automated Serv
Fee"",RC[-1],"""")"
RowState.Cells(i, 10).Activate
ActiveCell.FormulaR1C1 =
"=IF(ISBLANK(OFFSET(RC,1,-3)),OFFSET(RC,1,-2),"""")"
If x < 1 Then
StartTargetRange = Rows(i, 9)
x = 1
End If
End If
EndTargetRange = Rows(i, 9)
Next
<<<END OF PROBLEM LOOP!!!

'Copy relative values to temp spreadsheet, paste, and copy back absolute
values
'So subtotal lines and "ARC Automated Serv Fee" lines can be deleted in
another step.
Range("I:J", Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Unmatched").Select
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Range("A1").Select
Sheets(1).Select

Range("A1:O1").Select
Range("O1").Activate
Selection.Copy
Sheets("Unmatched").Select
Range("A1").Select
ActiveSheet.Paste
Range("E8").Select
ShieldsUp ''Custom Subroutine to Enable document protection with
special parameters
End Sub


The first formula calculates fee values by subtracting non-fee charges from
the transaction total. The second provides the transaction total. There may
well be a MUCH shorter, easier way to accomplish this task, and I'd love to
know about it!

Can anyone help me make this work? Thanks in advance!

Sincerely,
Damian Carrillo



PS: The part of the code I can't make work is based loosely on a post from
April 2005. I thought it might be adequate for my purposes, unfortunately I
quite understand how to modify the loop to work for my purposes.


Subject: AutoFilter, Looping through the Rows? (Newbie) 4/12/2005
11:00 AM PST
By: Tom Ogilvy In: microsoft.public.excel.programming


Dim vArr(0 to 6)
i = -1
for each rw in ActiveSheet.Autofilter.Range.rows
if rw.Entirerow.Hidden = False then
i = i + 1
vArr(i) = rw.Cells(1,1).Value
end if
Next

header row will be in varr(0)

--
Regards,
Tom Ogilvy

------------------------------------------------
"Barton" wrote in message
ups.com...

Hi,
I've set an AutoFilter on Date and Company Name. COLUMNS:
Date, Reference Number, Goods
G-VAT, Cheque Number, Services
S-VAT, New Balance, Previous Balance
Company Name

It selects 6 rows, as expected. I'm required to pre-process each row for
certain column information, i.e. ignore Cheque Number and Previous Balance.
How can I read into an array, a line at a time, and loop round all the
selected Rows?

Thanks in advance,
Mark.

Damian

I haven't worked my way through all of your code but hopefully this will
help. The following code autofilters data on a sheet, adds two columns (I and
J) and then inserts formulas into the visible cells in columns I and J.

Sub AddFormula()

Dim endRow As Long

Selection.AutoFilter Field:=8, Criteria1:="Y"

Range("I1").EntireColumn.Insert
Range("I1").EntireColumn.Insert

endRow = Cells(Rows.Count, 8).End(xlUp).Row

Range(Cells(2, 9), Cells(endRow, 9)). _
SpecialCells(xlCellTypeVisible).FormulaR1C1 _
= "=IF(RC[-6]20,""My First Formula"","""")"

Range(Cells(2, 10), Cells(endRow, 10)). _
SpecialCells(xlCellTypeVisible).FormulaR1C1 _
= "=IF(RC[-9]20,""My Second Formula"","""")"

End Sub

Regards
Rowan

"Damian Carrillo" wrote:

I'm working on summarizing a reconsillation statement. My code is supposed
to apply an autofilter based on fixed criteria. That part works. Next it
should insert formulas into the filtered/visible cells to create in-line
subtotals. The formulas are inserted into Columns "I" and "J" of the visble
rows. I haven't figured out how to accomplish this feat. (I've labeled
custom subroutines) My code is as follows:

Sub AutoFilterAndSummarize()
'Macro for Step II of Air Travel Bill Processor. This module condenses
the entries by KEY,
'enabling each transaction to appear as a single line in the datafile.
Dim StartTargetRange As Range
Dim EndTargetRange As Range
Dim x As Integer

'Disable Sheet Protection and select entire dataset
ShieldsDown 'Custom Subroutine to disable protection
Workbooks("Travel.xls").Activate
SelectCurrentRegion 'Custom Subroutine to select current data set

'Isolate Valid Records as a Cautionary Measure.
'Technically no invalid records should remain when this step is run.
'But this code will allow availible information to be summarized.
Selection.AutoFilter Field:=13, Criteria1:="=||*", Operator:=xlAnd
Selection.Subtotal GroupBy:=13, Function:=xlSum, TotalList:=Array(8), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

'Insert blank columns for Service Fee and Transaction Total columns
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight

Dim Visibility As Range, RowState As String, i As Integer
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row

<<<PROBLEM LOOP!!! INSERT FORMULAS & CAPTURE 1ST & LAST ROW VALUES OF
FILTERED/VISIBLE DATA
'ReDim RowState(1 To ActiveSheet.UsedRange.Rows.Count)
x = 0
i = -1
For Each RowState In ActiveSheet.AutoFilter.Range.Rows
i = i + 1
If RowState.EntireRow.Hidden = False Then
RowState.Cells(i, 9).Activate
ActiveCell.FormulaR1C1 = "=IF(RC[-5]=""ARC Automated Serv
Fee"",RC[-1],"""")"
RowState.Cells(i, 10).Activate
ActiveCell.FormulaR1C1 =
"=IF(ISBLANK(OFFSET(RC,1,-3)),OFFSET(RC,1,-2),"""")"
If x < 1 Then
StartTargetRange = Rows(i, 9)
x = 1
End If
End If
EndTargetRange = Rows(i, 9)
Next
<<<END OF PROBLEM LOOP!!!

'Copy relative values to temp spreadsheet, paste, and copy back absolute
values
'So subtotal lines and "ARC Automated Serv Fee" lines can be deleted in
another step.
Range("I:J", Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Unmatched").Select
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Range("A1").Select
Sheets(1).Select

Range("A1:O1").Select
Range("O1").Activate
Selection.Copy
Sheets("Unmatched").Select
Range("A1").Select
ActiveSheet.Paste
Range("E8").Select
ShieldsUp ''Custom Subroutine to Enable document protection with
special parameters
End Sub


The first formula calculates fee values by subtracting non-fee charges from
the transaction total. The second provides the transaction total. There may
well be a MUCH shorter, easier way to accomplish this task, and I'd love to
know about it!

Can anyone help me make this work? Thanks in advance!

Sincerely,
Damian Carrillo



PS: The part of the code I can't make work is based loosely on a post from
April 2005. I thought it might be adequate for my purposes, unfortunately I
quite understand how to modify the loop to work for my purposes.


Subject: AutoFilter, Looping through the Rows? (Newbie) 4/12/2005
11:00 AM PST
By: Tom Ogilvy In: microsoft.public.excel.programming


Dim vArr(0 to 6)
i = -1
for each rw in ActiveSheet.Autofilter.Range.rows
if rw.Entirerow.Hidden = False then
i = i + 1
vArr(i) = rw.Cells(1,1).Value
end if
Next

header row will be in varr(0)

--
Regards,
Tom Ogilvy

------------------------------------------------
"Barton" wrote in message
ups.com...

Hi,
I've set an AutoFilter on Date and Company Name. COLUMNS:
Date, Reference Number, Goods
G-VAT, Cheque Number, Services
S-VAT, New Balance, Previous Balance
Company Name

It selects 6 rows, as expected. I'm required to pre-process each row for
certain column information, i.e. ignore Cheque Number and Previous Balance.
How can I read into an array, a line at a time, and loop round all the
selected Rows?

Thanks in advance,
Mark.

Rowan,

A very belated thank you for the help! Your method worked so well I have
started using it for setting cell values in all my projects! I was so
excited when I first read the post weeks ago and found that it worked! But I
forgot to respond! My apologies and thanks again!

Damian

"Rowan" wrote:

Damian

I haven't worked my way through all of your code but hopefully this will
help. The following code autofilters data on a sheet, adds two columns (I and
J) and then inserts formulas into the visible cells in columns I and J.

Sub AddFormula()

Dim endRow As Long

Selection.AutoFilter Field:=8, Criteria1:="Y"

Range("I1").EntireColumn.Insert
Range("I1").EntireColumn.Insert

endRow = Cells(Rows.Count, 8).End(xlUp).Row

Range(Cells(2, 9), Cells(endRow, 9)). _
SpecialCells(xlCellTypeVisible).FormulaR1C1 _
= "=IF(RC[-6]20,""My First Formula"","""")"

Range(Cells(2, 10), Cells(endRow, 10)). _
SpecialCells(xlCellTypeVisible).FormulaR1C1 _
= "=IF(RC[-9]20,""My Second Formula"","""")"

End Sub

Regards
Rowan