Find Month - Help with VBA

[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

 

[Per Jessen]

Linda,

To do more than one statement if a condition is true use this structure:

If A=B then
Statement A
Statement B
Else
Statement C
Statement D
End If

I think this is what you need:

If intMnth = 0 Then
MsgBox "No data for previous Year To Date", vbInformation
Call DataNothing
End If

Regards,
Per

 

[Kassie]

It does not copy the range, since the instruction is merely to select the
range!

Range("E1").EntireColumn.SpecialCells(xlCellTypeConstants, 23).Select
Do Until intMnth = 0 and again
For Each rng In Selection
If rng.Value = strMonths(intMnth) Then
rng.Select

You have to telle it to copy whatever you want to copy, and by the way, it
is not necessary to select in order to copy!

You can change the word Select to Copy to copy the range, but then you also
have to designate a destination for the copy.

Not knowing where you want to copy to, of course makes it difficult to be
exact.

--
HTH

Kassie

Replace xxx with hotmail

 

[mathel]

When I put 'End If' after 'Call DataNothing', I get "COMPILE ERROR: End If
without Block If"

Any ideas?

 

[mathel]

Actually, right after the 'Call DataNothing' statement, the next group of
instruction is to move the curser up 2 rows, select the next 7 rows and the
next column, copy, return to original wb, past the data.

So, if no 'month' found, it gives me notice 'No data found' (vbinformation)
and should run the sub-routine DataNothing, otherwise do the following:

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,
etc.....

I hope this helps clarify. Perhaps the section to move and copy the range
should be named as a sub routine, then add End If and Else? I think I tried
this but got an error.

 

[Per Jessen]

You can not have any instructions after "Then" in the IF..Then statement
line. Move MsgBox... statement to next line and use End If to indicate no
more statements to do if your If..Then statement is true.

Regards,
Per

 

[Per Jessen]

This should be what you need:

If intMnth = 0 Then
MsgBox "No data for previous Year To Date", vbInformation
Call DataNothing
Else
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 If

Regards,
Per

 

[mathel]

THANK YOU!! This works now.
--
Linda

You can not have any instructions after "Then" in the IF..Then statement
line. Move MsgBox... statement to next line and use End If to indicate no
more statements to do if your If..Then statement is true.

Regards,
Per

 

[Dana DeLouis]

For intCtr = 1 To 12

strMonths(intCtr) = Format(DateSerial(Year(Date), intCtr, 1), "mmm")

As a side note, you are looping to generate the names of the month.
See if there are any ideas here you can use...

Sub Demo()
Dim mth, mthName, AllMonths

mth = Month(Date)
mthName = MonthName(mth, True)
AllMonths = Application.GetCustomListContents(3)
End Sub

= = =
HTH
Dana DeLouis