asked on

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

calacuccia

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

calacuccia

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

kristinca

ASKER

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.

calacuccia

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

kristinca

ASKER

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.

ASKER CERTIFIED SOLUTION

ture

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ture

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

kristinca

ASKER

Ture,

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

Kristin

ture

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

ture

I made a mistake, of course:

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

/Ture

kristinca

ASKER

Thanks!