VBA Behind Excel Worksheet

I am looking at the code behind an Excel spreadsheet.  In the spreadsheet data is uploaded when you select the year and month from which would like the data returned.  The month and year are seleted separately from two combo boxes in a dialogue bos form that prompts the user.  The data is displayed in colums by moth and corresponding year.  The problem that I am looking at is when a month past the current month, for eample Mrach that has no dat yet, is selected for the parameters data is still filled in the appropriate column, but uses the data from the last entered month.  The code for the updating is  below, can this be fixed so that no data is displayed if there is no data enetered for the particular month.



Sub UPDATE(ByRef cmo, cyr)
    Application.ScreenUpdating = False
    comp = Right(ActiveSheet.Name, 3)
    COFA
    DATA comp, cmo, cyr
    Sheets("WCAP_" & comp).Select
    Cells.Columns.Hidden = False
    ActiveWindow.FreezePanes = False
    ActiveSheet.Cells.RemoveSubtotal
    Range("A10:A" & Range("A10").End(xlDown).Row).EntireRow.Delete
    Range("data").Copy
    Range("A10").PasteSpecial xlValues
    Range("B10").Select
    With Selection.Borders
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = 1
    End With
    Selection.Copy
    Range("B10:T" & ActiveCell.End(xlDown).Row).PasteSpecial Paste:=xlPasteFormats
    Range("A9").Select
    Application.DisplayAlerts = False
    ActiveCell.CurrentRegion.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveCell.CurrentRegion.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    Application.DisplayAlerts = True
    Columns("C:C").Select
    Selection.Replace What:=" Total", Replacement:="", LookAt:=xlPart
    Range("A9").Select
    For counter = 1 To Selection.CurrentRegion.Rows.Count - 2
        Select Case ActiveCell.Rows.OutlineLevel
            Case 2
                ActiveCell.Formula = ActiveCell.Offset(-1, 0).Formula
                ActiveCell.Offset(0, 2).Formula = ActiveCell.Formula & " TOTAL"
                With ActiveCell.Range("B1")
                    .Borders.LineStyle = xlLineStyleNone
                    .BorderAround Weight:=xlHairline
                    .Font.ColorIndex = xlColorIndexAutomatic
                    .Font.Bold = True
                    .RowHeight = 14
                    With .Interior
                        .ColorIndex = 19
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                    End With
                End With
                ActiveCell.Range("B1").Copy
                ActiveCell.Range("B1:T1").PasteSpecial xlPasteFormats
                With ActiveCell.Range("A1:D1")
                    .Borders.LineStyle = xlLineStyleNone
                    .BorderAround Weight:=xlHairline
                End With
                ActiveCell.Offset(1, -1).Select
            Case 3
                ActiveCell.Formula = ActiveCell.Offset(-1, 0).Formula
                ActiveCell.Offset(0, 1).Formula = "'" & ActiveCell.Offset(-1, 1).Formula
                ActiveCell.Offset(0, 5).Formula = "'" & ActiveCell.Offset(-1, 5).Formula
                ActiveCell.Offset(0, 6).Formula = "'" & ActiveCell.Offset(-1, 6).Formula
                ActiveCell.Offset(0, 7).Formula = "'" & ActiveCell.Offset(-1, 7).Formula
                With ActiveCell.Range("B1")
                    .Borders.LineStyle = xlLineStyleNone
                    .BorderAround Weight:=xlHairline
                    .Font.ColorIndex = xlColorIndexAutomatic
                    .Font.Bold = True
                End With
                ActiveCell.Range("B1").Copy
                ActiveCell.Range("B1:T1").PasteSpecial xlPasteFormats
                With ActiveCell.Range("B1:D1")
                    .Borders.LineStyle = xlLineStyleNone
                    .BorderAround Weight:=xlHairline
                End With
                ActiveCell.Offset(1, -1).Select
            Case Else
                ActiveCell.Offset(1, 0).Range("A1").Select
        End Select
    Next
    ActiveCell.Formula = "'"
    ActiveCell.Offset(0, 2).Formula = "TOTAL WORKING CAPITAL"
    With ActiveCell.Range("B1")
        .Borders.LineStyle = xlLineStyleNone
        .BorderAround Weight:=xlHairline
        .Font.ColorIndex = xlColorIndexAutomatic
        .Font.Bold = True
        .RowHeight = 14
        With .Interior
            .ColorIndex = 19
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
    End With
    ActiveCell.Range("B1").Copy
    ActiveCell.Range("B1:T1").PasteSpecial xlPasteFormats
    With ActiveCell.Range("A1:F1")
        .Borders.LineStyle = xlLineStyleNone
        .BorderAround Weight:=xlHairline
    End With
    ActiveCell.Offset(1, 0).EntireRow.Delete
    Range("B4").Formula = "'" & UCase(Format(DateSerial(cyr, cmo + 1, 1) - 1, "mmmm dd, yyyy"))
    Range("T7").Select
    For Count = 1 To 12
        ActiveCell.Formula = "'" & UCase(Format(DateSerial(cyr, cmo + 1, 1) - 1, "mmm yy "))
        cmo = cmo - 1
        If cmo = 0 Then
            cmo = 12
            cyr = cyr - 1
        End If
        ActiveCell.Offset(0, -1).Select
    Next
    Range("A10").CurrentRegion.Copy
    Range("A10").PasteSpecial xlValues
    Range("A:A").ColumnWidth = 3.5
    Range("B:B,D:D,F:H").ColumnWidth = 7
    Range("C:C,E:E").ColumnWidth = 20
    With Columns("I:T")
        .NumberFormat = "#,##0_);(#,##0);"
        .ColumnWidth = 14.5
        .HorizontalAlignment = xlRight
    End With
    Range("T2").Formula = "RUN: " & UCase(Format(Now, "yy/mm/dd  hh:mm")) & " "
    Application.Goto Range("A1"), True
    Range("I10").Select
    ActiveWindow.FreezePanes = True
    ActiveSheet.Outline.ShowLevels RowLevels:=3
    Application.StatusBar = False
    With ActiveSheet.PageSetup
        .PrintArea = "B2:T" & Range("A10").End(xlDown).Row + 1
        .Orientation = xlLandscape
        .Zoom = 63
    End With
End Sub





Sub DATA(ByRef comp, cmo, cyr)
    Sheets("DATA").Visible = True
    Sheets("DATA").Select
    Columns("B:Z").Delete
    Range("C2").Select
'    cyr = 1998
'    cmo = 1
    cdt = cyr * 100 + cmo
    If cmo = 12 Then
        pdt = cyr * 100 + 1
    Else
        pdt = (cyr - 1) * 100 + (cmo + 1)
    End If
    With ActiveSheet.QueryTables.Add(Connection:="ODBC;DRIVER={Oracle73 Ver 2.5};DBQ=RANGERP;UID=RANGER;PWD=RANGER", _
            Destination:=ActiveCell)
        .Sql = Array( _
            "SELECT ACCOUNT, SUB_FEAT, BAL_N_ITD AS AMT, YEAR*100+PER_NO AS ACMO ", _
            "FROM GLBALANCE_SF ", _
            "WHERE COMP='" & comp & "' AND (YEAR*100+PER_NO BETWEEN " & pdt & " AND " & cdt & ") AND ", _
                "PER_NO NOT BETWEEN 13 AND 14 AND ", _
                "(ACCOUNT BETWEEN '1300' AND '1500' OR ACCOUNT BETWEEN '4000' AND '4999') ")
        .FieldNames = True
        .Refresh False
    End With
    Range("D3:D" & Range("C3").End(xlDown).Row).Select
    Selection.Replace What:="", Replacement:="'000", LookAt:=xlWhole
    Range("B2").Formula = "ACCT"
    Range("B3").Formula = "=C3&D3"
    Range("B3").Copy
    Range("B3:B" & Range("C3").End(xlDown).Row).PasteSpecial
    Selection.Copy
    Selection.PasteSpecial xlValues
    Columns("C:D").EntireColumn.Delete
    ActiveWorkbook.Names.Add Name:="data", RefersTo:="=DATA!$B$2:$D$" & Range("B2").End(xlDown).Row
    Range("F2").Select
    ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:="data", _
        TableName:="PivotTableA", RowGrand:=False, ColumnGrand:=False
    ActiveSheet.PivotTables("PivotTableA").AddFields RowFields:="ACCT", ColumnFields:="ACMO"
    With ActiveSheet.PivotTables("PivotTableA").PivotFields("AMT")
        .Orientation = xlDataField
        .Name = "Sum of AMT"
        .Function = xlSum
    End With
    Range("F2.R" & Range("F2").End(xlDown).Row).Copy
    Range("AA2").PasteSpecial xlPasteValues
    Columns("B:R").Delete
    Range("fmla1").Copy
    Range("B4:B" & Range("J2").End(xlDown).Row).PasteSpecial
    Selection.Copy
    Selection.PasteSpecial xlValues
    Range("J2").EntireColumn.Delete
    Range("B2:B3").EntireRow.Delete
    ActiveWorkbook.Names.Add Name:="data", RefersTo:="=DATA!$B$2:$U$" & Range("B2").End(xlDown).Row
    Columns("A:U").AutoFit
    For r = ActiveSheet.Names.Count To 1 Step -1
        ActiveSheet.Names(r).Delete
    Next
    Application.Goto Range("A1"), True
    Sheets("DATA").Visible = False
End Sub

Sub COFA()
    Sheets("COFA").Visible = True
    Sheets("COFA").Select
    Columns("A:Z").Delete
    Range("C2").Select
    With ActiveSheet.QueryTables.Add(Connection:="ODBC;DRIVER={Oracle73 Ver 2.5};DBQ=RANGERP;UID=RANGER;PWD=RANGER", _
            Destination:=ActiveCell)
        .Sql = Array( _
            "SELECT ACCOUNT AS MAJ, NAME AS MAJOR, SUBL_CODE AS CODE, SUBL_NO AS TYPE, USER_CODE_01 AS RESP ", _
            "FROM GLACCOUNT ", _
            "WHERE COMP='01C' AND (ACCOUNT BETWEEN '1300' AND '1500' OR ACCOUNT BETWEEN '4000' AND '4999') ")
        .FieldNames = True
        .Refresh False
    End With
    Range("E2:F2").EntireColumn.Insert
    Range("E2").Formula = "MIN"
    Range("F2").Formula = "MINOR"
    Range("E3:E" & Range("C2").End(xlDown).Row).Formula = "'000"
    Range("D3:D" & Range("C2").End(xlDown).Row).Copy
    Range("F3").PasteSpecial
    Range("G3:H" & Range("C2").End(xlDown).Row).Select
    Selection.Replace What:="NA", Replacement:="", LookAt:=xlWhole
    Range("C2").End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    With ActiveSheet.QueryTables.Add(Connection:="ODBC;DRIVER={Oracle73 Ver 2.5};DBQ=RANGERP;UID=RANGER;PWD=RANGER", _
            Destination:=ActiveCell)
        .Sql = Array( _
            "SELECT A.ACCOUNT, B.NAME, A.SUB_FEAT, A.DESCR, A.USER_CODE_01 ", _
            "FROM OG_SUBF A, GLACCOUNT B ", _
            "WHERE A.COMP='01C' AND (A.ACCOUNT BETWEEN '1300' AND '1500' OR A.ACCOUNT BETWEEN '4000' AND '4999') AND ", _
            "A.COMP=B.COMP AND A.ACCOUNT=B.ACCOUNT ")
        .FieldNames = False
        .Refresh False
    End With
    Range("G" & ActiveCell.Row & ":H" & Range("C2").End(xlDown).Row).Insert xlShiftToRight
    Range("G3:I" & Range("C2").End(xlDown).Row).Select
    Selection.Replace What:="", Replacement:="'", LookAt:=xlWhole
    Range("C2:I" & Range("C2").End(xlDown).Row).Select
    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("E2"), Order2:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("B2").Formula = "ARAP"
    Range("B3").Select
    While VarType(ActiveCell.Offset(0, 1)) <> 0
        If ActiveCell.Offset(0, 1).Value < "4000" Then
            ActiveCell.Formula = "AR"
            ActiveCell.Offset(1, 0).Select
        Else
            ActiveCell.Formula = "AP"
            ActiveCell.Offset(1, 0).Select
        End If
    Wend
    Range("A2").Formula = "MAJMIN"
    Range("A3").Formula = "=C3&E3"
    Range("A3").Copy
    Range("A3:A" & Range("B2").End(xlDown).Row).PasteSpecial
    Selection.Copy
    Selection.PasteSpecial xlValues
    Range("A2:H2").Font.Bold = True
    ActiveWorkbook.Names.Add Name:="cofa", RefersTo:="=COFA!$A$2:$I$" & Range("A2").End(xlDown).Row
    Columns("A:I").AutoFit
    For r = ActiveSheet.Names.Count To 1 Step -1
        ActiveSheet.Names(r).Delete
    Next
    Application.Goto Range("A1"), True
    Sheets("COFA").Visible = False
End Sub








Sub VIEWMONT(ByRef vmont)
    Application.ScreenUpdating = False
    Cells.Columns.Hidden = False
    ActiveWindow.FreezePanes = False
    If vmont < 1 Then vmont = 1
    If vmont > 12 Then vmont = 12
    If vmont < 12 Then
        Range("I7").Select
        For Count = 1 To (12 - vmont)
            ActiveCell.EntireColumn.Hidden = True
            ActiveCell.Offset(0, 1).Select
        Next
    End If
    Application.Goto Range("A1"), True
    Range("I10").Select
    ActiveWindow.FreezePanes = True
    Application.StatusBar = False
End Sub






Sub GET_APS200()
    Workbooks.OpenText FileName:="H:\DATA\EXCEL\aps200.lst", Origin:=xlWindows _
        , StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array( _
        3, 2), Array(15, 1), Array(62, 1), Array(80, 1), Array(98, 1), Array(116, 1), Array(133, 1), _
        Array(150, 1), Array(167, 1))
    Rows("1:34").Delete xlUp
    endrow = ActiveSheet.UsedRange.Rows.Count
    For Count = 1 To endrow
        If VarType(ActiveCell()) = 0 Or VarType(ActiveCell.Offset(0, 1)) = 0 Or ActiveCell.Formula = "APS" Or ActiveCell.Formula = "Rep" Then
            ActiveCell.EntireRow.Delete
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Next
    Range("K1").Select
    Selection.Formula = "=IF(RIGHT(D1,1)=""-"",VALUE(""-""&LEFT(D1,LEN(D1)-1)),D1)"
    ActiveCell.Copy
    Range("K1:P" & Range("A1").End(xlDown).Row).PasteSpecial
    Selection.Copy
    Selection.PasteSpecial xlValues
    Selection.Copy
    Range("D1").PasteSpecial
    Range("K1:P1").EntireColumn.Delete
    Application.Goto Range("A1"), True
End Sub




Sub TEST()
    Cells.Columns.Hidden = False
    ActiveCell.EntireColumn.Hidden = True
End Sub



kristincaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

calacucciaCommented:
Hi Kristinca,

I think this little modification should do the job:
The first sub now looks like (.... represents everything I didn't copy)

Sub UPDATE(ByRef cmo, cyr)
    Application.ScreenUpdating = False
    .....
    End With
End Sub

Change this to

Sub UPDATE(ByRef cmo, cyr)
    If Month(Date) < cmo And Year(Date) <= cyr  Or Year(Date)<cyr Then
    Application.ScreenUpdating = False
    ......
    End With
    End If    
Exit Sub


This will immediately at the start of procedures check the values of cmo and cyr (returned by the input user from, I presume) and if proposed date is later than this month's date (returned by DATE function), then execution is cancelled.

Good Luck

Calacuccia
0
calacucciaCommented:
Terribly sorry, something went wrong with the comment in the changed sub. Ignore my first comment, and try this sub

Sub UPDATE(ByRef cmo, cyr)
    If Month(Date) < cmo And Year(Date) <= cyr  Or Year(Date)<cyr Then
    Exit Sub
    Else
    Application.ScreenUpdating = False
    ......
    End With
    End If    
End Sub

Calacuccia
0
kristincaAuthor Commented:
Now it is not even updating at all for any year.  I just want to show you the code behind the dialouge box form  where a year and month is selected for update.


Sub UBOX()
    cyr = Year(Date)
    cmo = Month(Date)
    Application.ScreenUpdating = True
    On Error Resume Next
    With FWcap
        .bxcyr.Clear
       For count1 = 2010 To 1994 Step -1
            .bxcyr.AddItem count1
        Next
        .bxcmo.Clear
        For count1 = 12 To 1 Step -1
            .bxcmo.AddItem count1
        Next
        .bxcyr.Text = cyr
        .bxcmo.Text = cmo
    End With
    With FWcap
        .Show
        If FWcap.Tag = vbCancel Then
            Application.StatusBar = False
            Exit Sub
        End If
        cyr = .bxcyr.Value
        cmo = .bxcmo.Value
    End With
    On Error GoTo 0
    UPDATE cmo, cyr
End Sub



I put the End If right before the the end sub statement of the Sub Update code.  Is that correct and the End With I did not add in at all.  Just assumed it was already in the code because it was not in the above revised code that you gave me.
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

calacucciaCommented:
Hi Kristinca,

First of all, I think you interpreted my modification on the Sub Update correctly, the only lines to add are:

If Month(Date) < cmo And Year(Date) <= cyr  Or Year(Date)<cyr Then
Exit Sub
Else

in the start of the sub (first three lines) and:

End If

right before the End Sub statement.

Then, the main thing, getting your code to work... Normally (I rechecked) the condition should work correctly.
The code will be executed ONLY if (speaking for today, Year=2000 and Month=2):
- If the year you entered is inferior to 2000

OR

- If the year you entered is 2000 AND the month you entered is 1 or 2.

So, briefly, if you select a month/year combination not reached yet at the moment of execution, the updating won't run. The only thing I can think of right now is the AND OR combination not being interpreted correctly by your machine, which I doubt. Anyway changing the If line to below will do, in that case:

If (Month(Date) < cmo And Year(Date) <= cyr)  Or Year(Date)<cyr Then

Good Luck

Calacuccia
0
kristincaAuthor Commented:
There has to be something wrong somewhere.  Logically it should work but it exits on any date.  I put a Messagebox in instead of the Exit sub and the Messagebox comes up on every date I select.  What could be the problem?  I have tried the last suggestion but doesn't make a difference.
0
tureCommented:
kristinca,

To avoid running the UPDATE procedure if the date indicated by cyr and cmo is larger than the current date, add this line as the very first line in the UPDATE procedure:

  If DateSerial(cyr, cmo,1) > Date Then Exit Sub

Ture Magnusson
Karlstad, Sweden
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
tureCommented:
kristinca,

Note that my suggested modification is to your originally posted code, I'm not taking into account any of the changes that Calacuccia has suggested.

/Ture
0
kristincaAuthor Commented:
Ture,

It works, thank you very much!  Could you explain a little about the DateSerial(), please.  I not familiar with it?  Thanks again.

Kristin
0
tureCommented:
Kristin,

Thanks for accepting my answer. I'm glad that I could help you.

DateSerial is a simple function that takes year number, month number and day number as arguments and returns a date.

MsgBox DateSerial(1999,12,25)  shows 1999-12-31  (with my regional settings)

The 'Day' argument should be thought of as the n'th day from the beginning of the month.

MsgBox DateSerial(1999,3,2)    shows 1999-03-02
MsgBox DateSerial(1999,3,1)    shows 1999-03-01
MsgBox DateSerial(1999,3,0)    shows 1999-02-28
MsgBox DateSerial(1999,3,31)   shows 1999-03-31
MsgBox DateSerial(1999,3,32)   shows 1999-04-01

The Month argument works in a similar way.

MsgBox DateSerial(1999,13,17)  shows 2000-01-17

/Ture
0
tureCommented:
I made a mistake, of course:

MsgBox DateSerial(1999,12,25)  shows 1999-12-25  (with my regional settings)

/Ture
0
kristincaAuthor Commented:
Thanks!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.