VBA to create series of workbooks need to add code to skip creating areport if no lines meet criteri

F

Forgone

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
 
F

Forgone

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
Click to expand...

Any ideas or too hard?
 
F

Forgone

Any ideas or too hard?
Click to expand...

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
 
Top