Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > VBA to create series of workbooks need to add code to skip creating areport if no lines meet criteria
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 60
Default VBA to create series of workbooks need to add code to skip creating areport if no lines meet criteria
Hi All,

I need some assistance as where I'm at with this report is far beyond
my level of knowledge and I'm hoping that someone can point me in the
right direction.

I've created a template that creates a report and displays variances
based on the "search criteria" which is defined in another worksheet
and hides any rows that are equal to Zero and are between the value
(= -5000 AND <= +5000) and what I'm trying to figure out is if there
are no rows visible within the report then it should not save the
report (that way I don't email a blank worksheet).

NB: I've been looking at other examples which is how I came up with
this code.

I am thinking that I need to add something that if the number of
visible rows (excluding the the two headings, two subtotals and one
grand total) that it should goto NEXT C and skip creating the file.

Whilst its not important at this point in time, every line in
"loop.range" is manually added, however, the code halts and goes into
debug mode if one of the cells is empty. In order to just filter on
cells that are not empty, should I do something similar to the
UsedRange. Currently, the named range "loop.range" is from cells
"A2:A222" but if I only had 2 entries in that range, I'd want it to
stop and do the "game over" rather than halt. What is the better way
to do this? I'm not sure if the named range is good because if I add
more lines then I'll have to expand the cells of the range. Any
suggestions to rectify this would be good, but its not on the priority
list.

Thanks for helping, it is sincerely appreciated.

The VBA code is....


' Declare Revenue/Expense/Hide Flags
Const RevenueFlag As String = "R"
Const ExpenseFlag As String = "E"
Const HideFlag As String = "H"
Public TemplateRow As Range
' Column numbers
Const CTLcn As Long = 1
Const ACTcn As Long = 5
Const BGTcn As Long = 6
Const VARcn As Long = 7

' set Zero to 0
Const Zero As Double = 0
'
################################################## ################################################## #################################################

Sub prepare_reports_for_distribution()
Dim MASTERwks, SAVEwks, RepWKS, Delimiter As String
Dim SplitText, S2, S3, S4, fname, bname As Variant
Dim TheIndex As Long
Dim MyPath As String
Dim FilterHigh, FilterLow As Double

' turn off screen updating
Application.ScreenUpdating = False
' set calculation to manual
Application.Calculation = xlCalculationManual

MyPath = Range("WorkDIR").Value
MASTERwks = ThisWorkbook.Name
RepWKS = ActiveSheet.Name
Set MyReportTemplate = Sheets(RepWKS)
SAVEwks = " - " & Range("reporting.month.text").Value & " - YTD
Variance Report"
Delimiter = "-"
FilterHigh = Range("filter.dollar.high").Value
FilterLow = Range("filter.dollar.low").Value

For Each C In Range("loop.range")
SplitText = Split(C.Value, Delimiter)
S2 = SplitText(2 - 1) ' Cost Centre
S3 = SplitText(3 - 1) ' Fund
S4 = SplitText(4 - 1) ' Project

' bname = Budget Name
bname = S2 & "-" & S3 & "-" & S4

Windows(MASTERwks).Activate
Worksheets(RepWKS).Activate

With Worksheets(RepWKS)
.Range("CCB") = S2
.Range("CCD") = S3
.Range("CCE") = S4
End With

Calculate

ActiveSheet.UsedRange.EntireRow.Hidden = False

For Each TemplateRow In MyReportTemplate.UsedRange.Rows
If TemplateRow.Cells(CTLcn) = RevenueFlag Or TemplateRow.Cells
(CTLcn) = ExpenseFlag Then
If TemplateRow.Cells(ACTcn) = Zero And TemplateRow.Cells
(BGTcn) = Zero And TemplateRow.Cells(VARcn) = Zero Then
TemplateRow.EntireRow.Hidden = True
If TemplateRow.Cells(VARcn) = FilterLow And TemplateRow.Cells
(VARcn) <= FilterHigh Then TemplateRow.EntireRow.Hidden = True
End If

Next

For Each TemplateRow In MyReportTemplate.UsedRange.Rows
If TemplateRow.Cells(CTLcn) = HideFlag Then
TemplateRow.EntireRow.Hidden = True
Next

fname = bname & SAVEwks & ".xls"

Let FullSaveFN = MyPath & fname

Sheets(RepWKS).Select
Sheets(RepWKS).Copy
' Set up colours in net workbook
ActiveWorkbook.Colors = Workbooks("GL VARIANCE REPORT.xls").Colors


Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
ActiveWorkbook.SaveAs Filename:=FullSaveFN, FileFormat:=xlNormal

ActiveWindow.Close

Next C

' Reenable screen updating & calculation
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ActiveSheet.UsedRange.EntireRow.Hidden = False
MsgBox "Game Over Red Rover"

End Sub



Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 60
Default VBA to create series of workbooks need to add code to skipcreating a report if no lines meet criteria
On Nov 30, 4:55*pm, Forgone wrote:
Hi All,

I need some assistance as where I'm at with this report is far beyond
my level of knowledge and I'm hoping that someone can point me in the
right direction.

I've created a template that creates a report and displays variances
based on the "search criteria" which is defined in another worksheet
and hides any rows that are equal to Zero and are between the value
(= -5000 AND <= +5000) and what I'm trying to figure out is if there
are no rows visible within the report then it should not save the
report (that way I don't email a blank worksheet).

NB: I've been looking at other examples which is how I came up with
this code.

I am thinking that I need to add something that if the number of
visible rows (excluding the the two headings, two subtotals and one
grand total) that it should goto NEXT C and skip creating the file.

Whilst its not important at this point in time, every line in
"loop.range" is manually added, however, the code halts and goes into
debug mode if one of the cells is empty. In order to just filter on
cells that are not empty, should I do something similar to the
UsedRange. Currently, the named range "loop.range" is from cells
"A2:A222" but if I only had 2 entries in that range, I'd want it to
stop and do the "game over" rather than halt. *What is the better way
to do this? I'm not sure if the named range is good because if I add
more lines then I'll have to expand the cells of the range. Any
suggestions to rectify this would be good, but its not on the priority
list.

Thanks for helping, it is sincerely appreciated.

The VBA code is....

' Declare Revenue/Expense/Hide Flags
*Const RevenueFlag As String = "R"
*Const ExpenseFlag As String = "E"
*Const HideFlag As String = "H"
*Public TemplateRow As Range
' Column numbers
*Const CTLcn As Long = 1
*Const ACTcn As Long = 5
*Const BGTcn As Long = 6
*Const VARcn As Long = 7

' set Zero to 0
*Const Zero As Double = 0
'
################################################## ################################################## #################################################

Sub prepare_reports_for_distribution()
*Dim MASTERwks, SAVEwks, RepWKS, Delimiter As String
*Dim SplitText, S2, S3, S4, fname, bname As Variant
*Dim TheIndex As Long
*Dim MyPath As String
*Dim FilterHigh, FilterLow As Double

*' turn off screen updating
*Application.ScreenUpdating = False
*' set calculation to manual
*Application.Calculation = xlCalculationManual

*MyPath = Range("WorkDIR").Value
*MASTERwks = ThisWorkbook.Name
*RepWKS = ActiveSheet.Name
*Set MyReportTemplate = Sheets(RepWKS)
*SAVEwks = " - " & Range("reporting.month.text").Value & " - YTD
Variance Report"
*Delimiter = "-"
*FilterHigh = Range("filter.dollar.high").Value
*FilterLow = Range("filter.dollar.low").Value

*For Each C In Range("loop.range")
* SplitText = Split(C.Value, Delimiter)
* * S2 = SplitText(2 - 1) ' Cost Centre
* * S3 = SplitText(3 - 1) ' Fund
* * S4 = SplitText(4 - 1) ' Project

* * ' bname = Budget Name
* * bname = S2 & "-" & S3 & "-" & S4

Windows(MASTERwks).Activate
Worksheets(RepWKS).Activate

With Worksheets(RepWKS)
*.Range("CCB") = S2
*.Range("CCD") = S3
*.Range("CCE") = S4
End With

Calculate

ActiveSheet.UsedRange.EntireRow.Hidden = False

*For Each TemplateRow In MyReportTemplate.UsedRange.Rows
* * If TemplateRow.Cells(CTLcn) = RevenueFlag Or TemplateRow.Cells
(CTLcn) = ExpenseFlag Then
* * * * If TemplateRow.Cells(ACTcn) = Zero And TemplateRow.Cells
(BGTcn) = Zero And TemplateRow.Cells(VARcn) = Zero Then
TemplateRow.EntireRow.Hidden = True
* * * * If TemplateRow.Cells(VARcn) = FilterLow And TemplateRow.Cells
(VARcn) <= FilterHigh Then TemplateRow.EntireRow.Hidden = True
* * End If

*Next

For Each TemplateRow In MyReportTemplate.UsedRange.Rows
* * If TemplateRow.Cells(CTLcn) = HideFlag Then
TemplateRow.EntireRow.Hidden = True
Next

fname = bname & SAVEwks & ".xls"

Let FullSaveFN = MyPath & fname

Sheets(RepWKS).Select
*Sheets(RepWKS).Copy
*' Set up colours in net workbook
ActiveWorkbook.Colors = Workbooks("GL VARIANCE REPORT.xls").Colors

*Cells.Select
*Selection.Copy
*Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
* * :=False, Transpose:=False
*Range("A1").Select
*ActiveWorkbook.SaveAs Filename:=FullSaveFN, FileFormat:=xlNormal

*ActiveWindow.Close

*Next C

*' Reenable screen updating & calculation
*Application.ScreenUpdating = True
*Application.Calculation = xlCalculationAutomatic
*ActiveSheet.UsedRange.EntireRow.Hidden = False
*MsgBox "Game Over Red Rover"

*End Sub

Any ideas or too hard?
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 60
Default VBA to create series of workbooks need to add code to skipcreating a report if no lines meet criteria
On Dec 2, 11:50*am, Forgone wrote:
On Nov 30, 4:55*pm, Forgone wrote:



Hi All,

I need some assistance as where I'm at with this report is far beyond
my level of knowledge and I'm hoping that someone can point me in the
right direction.

I've created a template that creates a report and displays variances
based on the "search criteria" which is defined in another worksheet
and hides any rows that are equal to Zero and are between the value
(= -5000 AND <= +5000) and what I'm trying to figure out is if there
are no rows visible within the report then it should not save the
report (that way I don't email a blank worksheet).

NB: I've been looking at other examples which is how I came up with
this code.

I am thinking that I need to add something that if the number of
visible rows (excluding the the two headings, two subtotals and one
grand total) that it should goto NEXT C and skip creating the file.

Whilst its not important at this point in time, every line in
"loop.range" is manually added, however, the code halts and goes into
debug mode if one of the cells is empty. In order to just filter on
cells that are not empty, should I do something similar to the
UsedRange. Currently, the named range "loop.range" is from cells
"A2:A222" but if I only had 2 entries in that range, I'd want it to
stop and do the "game over" rather than halt. *What is the better way
to do this? I'm not sure if the named range is good because if I add
more lines then I'll have to expand the cells of the range. Any
suggestions to rectify this would be good, but its not on the priority
list.

Thanks for helping, it is sincerely appreciated.

The VBA code is....

' Declare Revenue/Expense/Hide Flags
*Const RevenueFlag As String = "R"
*Const ExpenseFlag As String = "E"
*Const HideFlag As String = "H"
*Public TemplateRow As Range
' Column numbers
*Const CTLcn As Long = 1
*Const ACTcn As Long = 5
*Const BGTcn As Long = 6
*Const VARcn As Long = 7

' set Zero to 0
*Const Zero As Double = 0
'
################################################## ################################################## #################################################

Sub prepare_reports_for_distribution()
*Dim MASTERwks, SAVEwks, RepWKS, Delimiter As String
*Dim SplitText, S2, S3, S4, fname, bname As Variant
*Dim TheIndex As Long
*Dim MyPath As String
*Dim FilterHigh, FilterLow As Double

*' turn off screen updating
*Application.ScreenUpdating = False
*' set calculation to manual
*Application.Calculation = xlCalculationManual

*MyPath = Range("WorkDIR").Value
*MASTERwks = ThisWorkbook.Name
*RepWKS = ActiveSheet.Name
*Set MyReportTemplate = Sheets(RepWKS)
*SAVEwks = " - " & Range("reporting.month.text").Value & " - YTD
Variance Report"
*Delimiter = "-"
*FilterHigh = Range("filter.dollar.high").Value
*FilterLow = Range("filter.dollar.low").Value

*For Each C In Range("loop.range")
* SplitText = Split(C.Value, Delimiter)
* * S2 = SplitText(2 - 1) ' Cost Centre
* * S3 = SplitText(3 - 1) ' Fund
* * S4 = SplitText(4 - 1) ' Project

* * ' bname = Budget Name
* * bname = S2 & "-" & S3 & "-" & S4

Windows(MASTERwks).Activate
Worksheets(RepWKS).Activate

With Worksheets(RepWKS)
*.Range("CCB") = S2
*.Range("CCD") = S3
*.Range("CCE") = S4
End With

Calculate

ActiveSheet.UsedRange.EntireRow.Hidden = False

*For Each TemplateRow In MyReportTemplate.UsedRange.Rows
* * If TemplateRow.Cells(CTLcn) = RevenueFlag Or TemplateRow.Cells
(CTLcn) = ExpenseFlag Then
* * * * If TemplateRow.Cells(ACTcn) = Zero And TemplateRow.Cells
(BGTcn) = Zero And TemplateRow.Cells(VARcn) = Zero Then
TemplateRow.EntireRow.Hidden = True
* * * * If TemplateRow.Cells(VARcn) = FilterLow And TemplateRow.Cells
(VARcn) <= FilterHigh Then TemplateRow.EntireRow.Hidden = True
* * End If

*Next

For Each TemplateRow In MyReportTemplate.UsedRange.Rows
* * If TemplateRow.Cells(CTLcn) = HideFlag Then
TemplateRow.EntireRow.Hidden = True
Next

fname = bname & SAVEwks & ".xls"

Let FullSaveFN = MyPath & fname

Sheets(RepWKS).Select
*Sheets(RepWKS).Copy
*' Set up colours in net workbook
ActiveWorkbook.Colors = Workbooks("GL VARIANCE REPORT.xls").Colors

*Cells.Select
*Selection.Copy
*Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
* * :=False, Transpose:=False
*Range("A1").Select
*ActiveWorkbook.SaveAs Filename:=FullSaveFN, FileFormat:=xlNormal

*ActiveWindow.Close

*Next C

*' Reenable screen updating & calculation
*Application.ScreenUpdating = True
*Application.Calculation = xlCalculationAutomatic
*ActiveSheet.UsedRange.EntireRow.Hidden = False
*MsgBox "Game Over Red Rover"

*End Sub

Any ideas or too hard?

It wasn't too hard...... just figured it out.... all I needed to do
was include a cell count that met the criteria in the settings page.
In a cell that I named report.criteria I inserted the formula

=SUMPRODUCT((GL_REPORT!G17:G822=5000)+(GL_REPORT! G17:G822<=-5000),
(GL_REPORT!A17:A822="E")+(GL_REPORT!A17:A822="R"))

This way it can count the number of rows that are either "greater than
5000" or "less than -5000" AND if the line is either an "EXPENSE" or
"REVENUE" so that I could eliminate adding up the sub and grant total
rows......

Runs sweet as now :)

Just need to figure out how to clean up the loop and I'll be extremely
happy!


The final code looks like this.....

' Declare Revenue/Expense/Hide Flags
Const RevenueFlag As String = "R"
Const ExpenseFlag As String = "E"
Const HideFlag As String = "H"
Public TemplateRow As Range
' Column numbers
Const CTLcn As Long = 1
Const ACTcn As Long = 5
Const BGTcn As Long = 6
Const VARcn As Long = 7

' set Zero to 0
Const Zero As Double = 0
'
################################################## ################################################## #################################################

Sub prepare_reports_for_distribution()
Dim MASTERwks, SAVEwks, RepWKS, Delimiter As String
Dim SplitText, S2, S3, S4, fname, bname As Variant
Dim TheIndex As Long
Dim MyPath As String
Dim FilterHigh, FilterLow, ReportCriteria As Double

' turn off screen updating
Application.ScreenUpdating = False
' set calculation to manual
Application.Calculation = xlCalculationManual

MyPath = Range("WorkDIR").Value
MASTERwks = ThisWorkbook.Name
RepWKS = ActiveSheet.Name
Set MyReportTemplate = Sheets(RepWKS)
SAVEwks = " - " & Range("reporting.month.text").Value & " - YTD
Variance Report"
Delimiter = "-"
FilterHigh = Range("filter.dollar.high").Value
FilterLow = Range("filter.dollar.low").Value


For Each C In Range("loop.range")
SplitText = Split(C.Value, Delimiter)
S2 = SplitText(2 - 1) ' Cost Centre
S3 = SplitText(3 - 1) ' Fund
S4 = SplitText(4 - 1) ' Project

' bname = Budget Name
bname = S2 & "-" & S3 & "-" & S4

Windows(MASTERwks).Activate
Worksheets(RepWKS).Activate

With Worksheets(RepWKS)
.Range("CCB") = S2
.Range("CCD") = S3
.Range("CCE") = S4
End With

Calculate

' Find out the number of rows that meet the report criteria and if 0
then generate report otherwise next C
ReportCriteria = Range("report.criteria").Value


If ReportCriteria 0 then

ActiveSheet.UsedRange.EntireRow.Hidden = False

For Each TemplateRow In MyReportTemplate.UsedRange.Rows
If TemplateRow.Cells(CTLcn) = RevenueFlag Or TemplateRow.Cells
(CTLcn) = ExpenseFlag Then
If TemplateRow.Cells(ACTcn) = Zero And TemplateRow.Cells
(BGTcn) = Zero And TemplateRow.Cells(VARcn) = Zero Then
TemplateRow.EntireRow.Hidden = True
If TemplateRow.Cells(VARcn) = FilterLow And TemplateRow.Cells
(VARcn) <= FilterHigh Then TemplateRow.EntireRow.Hidden = True
End If

Next

For Each TemplateRow In MyReportTemplate.UsedRange.Rows
If TemplateRow.Cells(CTLcn) = HideFlag Then
TemplateRow.EntireRow.Hidden = True
Next

fname = bname & SAVEwks & ".xls"

Let FullSaveFN = MyPath & fname

Sheets(RepWKS).Select
Sheets(RepWKS).Copy
' Set up colours in net workbook
ActiveWorkbook.Colors = Workbooks("GL VARIANCE REPORT.xls").Colors


Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
ActiveWorkbook.SaveAs Filename:=FullSaveFN, FileFormat:=xlNormal

ActiveWindow.Close
End If
Next C

' Reenable screen updating & calculation
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ActiveSheet.UsedRange.EntireRow.Hidden = False
MsgBox "Game Over Red Rover"

End Sub


Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
VLOOKUP to ignore lines which do not meet criteria Custard Tart Excel Worksheet Functions 1 August 18th 09 10:47 AM
Create a Macro to Delete All Rows that meet a certain criteria jpittari Excel Programming 1 November 1st 07 05:16 AM
Can I count total lines of VBA Code Executed in a Series of Subs? MikeZz Excel Programming 6 February 20th 07 05:32 PM
Counting lines that meet TWO criteria sam Excel Worksheet Functions 2 January 31st 06 09:04 PM
Excel skip some lines of VBA code Alex[_7_] Excel Programming 1 August 28th 03 12:18 PM


All times are GMT +1. The time now is 06:43 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement