M
mathel
Someone in this group was kind enough to write some VBA code for me, and it
works brilliantly up to a point. I think there may be a minor problem and I
don't know how to fix it.
What the macro has to do, using a WS cell that has a month in it (formatted
MMM), look in Column E in another WS for the month and continue back until a
month is found (ie: look for APR, if APR doesn't exist, look for MAR, etc.).
Once found, it is to copy a certain range, and paste it in the original WS.
If no data is found, then it is to go to the sub-routine 'DataNothing ( )'
and put '0' in the original form.
Where is is going wrong, it will find the month, however, rather than
copying the range, it is jumping immediately to the sub-routine 'DataNothing'
and following that. I have tried putting End If, Then, Else statements etc.
after 'vbinformation', or 'Call Sub DataNothing', but, I have very very
limited knowledge of VBA and cannot get it correct.
I am hoping somebody can help. The code I have is as follows:
Sheets("WRO Summary").Select
Dim rng As Range
Dim strMonths(12) As String
Dim str As String
Dim intMnth As Integer
Dim intCtr As Integer
For intCtr = 1 To 12
strMonths(intCtr) = Format(DateSerial(Year(Date), intCtr, 1), "mmm")
If strMonths(intCtr) = Format(DateSerial(Year(Date), Month(Date),
1), "mmm") Then
intMnth = intCtr
End If
Next
Range("E1").EntireColumn.SpecialCells(xlCellTypeConstants, 23).Select
Do Until intMnth = 0
For Each rng In Selection
If rng.Value = strMonths(intMnth) Then
rng.Select
Exit Do
End If
Next
intMnth = intMnth - 1
Loop
If intMnth = 0 Then MsgBox "No data for previous Year To Date",
vbInformation
Call DataNothing
ActiveCell.Offset(-2, 0).Select
Range(Selection, Selection.Offset(-7, 1)).Select
Selection.Copy
Windows("WRO Summary.xls").Activate
Sheets("Summary Over $10k").Select
Application.Goto "PrevYear"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("WRO Year Summery Over$10.xls").Activate
ActiveWindow.Close
End Sub
Sub DataNothing()
ActiveWindow.Close SaveChanges:=False
Windows("WRO Summary.xls").Activate
Application.Goto "PrevYear"
ActiveCell.FormulaR1C1 = "0"
Range("H24").Select
ActiveCell.FormulaR1C1 = "0"
Range("G24.H24").Select
Selection.Copy
Range("G25:G31").Select
Selection.PasteSpecial Paste:=x1PasteValues, Operation:=x1None,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Call Print_Over
End Sub
Thanks
Linda
works brilliantly up to a point. I think there may be a minor problem and I
don't know how to fix it.
What the macro has to do, using a WS cell that has a month in it (formatted
MMM), look in Column E in another WS for the month and continue back until a
month is found (ie: look for APR, if APR doesn't exist, look for MAR, etc.).
Once found, it is to copy a certain range, and paste it in the original WS.
If no data is found, then it is to go to the sub-routine 'DataNothing ( )'
and put '0' in the original form.
Where is is going wrong, it will find the month, however, rather than
copying the range, it is jumping immediately to the sub-routine 'DataNothing'
and following that. I have tried putting End If, Then, Else statements etc.
after 'vbinformation', or 'Call Sub DataNothing', but, I have very very
limited knowledge of VBA and cannot get it correct.
I am hoping somebody can help. The code I have is as follows:
Sheets("WRO Summary").Select
Dim rng As Range
Dim strMonths(12) As String
Dim str As String
Dim intMnth As Integer
Dim intCtr As Integer
For intCtr = 1 To 12
strMonths(intCtr) = Format(DateSerial(Year(Date), intCtr, 1), "mmm")
If strMonths(intCtr) = Format(DateSerial(Year(Date), Month(Date),
1), "mmm") Then
intMnth = intCtr
End If
Next
Range("E1").EntireColumn.SpecialCells(xlCellTypeConstants, 23).Select
Do Until intMnth = 0
For Each rng In Selection
If rng.Value = strMonths(intMnth) Then
rng.Select
Exit Do
End If
Next
intMnth = intMnth - 1
Loop
If intMnth = 0 Then MsgBox "No data for previous Year To Date",
vbInformation
Call DataNothing
ActiveCell.Offset(-2, 0).Select
Range(Selection, Selection.Offset(-7, 1)).Select
Selection.Copy
Windows("WRO Summary.xls").Activate
Sheets("Summary Over $10k").Select
Application.Goto "PrevYear"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("WRO Year Summery Over$10.xls").Activate
ActiveWindow.Close
End Sub
Sub DataNothing()
ActiveWindow.Close SaveChanges:=False
Windows("WRO Summary.xls").Activate
Application.Goto "PrevYear"
ActiveCell.FormulaR1C1 = "0"
Range("H24").Select
ActiveCell.FormulaR1C1 = "0"
Range("G24.H24").Select
Selection.Copy
Range("G25:G31").Select
Selection.PasteSpecial Paste:=x1PasteValues, Operation:=x1None,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Call Print_Over
End Sub
Thanks
Linda