R
RompStar
Below is my scipt: It asks for a two sets of date ranges, both from
column J, and then it does the rest.
Script works, no problem..
After the two sets of dates are entered for the range of column J, it
confirms the date Ranges, user clicks OK and then it goes on to the
next step.
I want it to change so that, If I enter let's say:
starting range: 1/1/2005
ending range: 3/1/2005 (from column J)
it would confirm the dates like it does now, but after the user pressed
ok, it would stop the script and pop-out a box saying:
Calculation can't be performed, missing Dates in selected Range..
Can Anyone help ?
Sub Main()
Dim LastRow As Long
Dim Rng As Range
Dim Msg As Integer
Dim BeginDate As Date
Dim EndDate As Date
Dim c As Range
Dim Item As Range
LastRow = Range("J11").End(xlDown).Row
Set Rng = Range("J11:J" & Range("J65536").End(xlUp).Row)
Do
Msg = vbOK
BeginDate = Application.InputBox("Enter Starting Date from column J:",
"Range Beginning", Type:=1)
If Not IsDate(BeginDate) Then
' Checks to see if entry is a date
Msg = MsgBox("Entry not a valid date!", vbCritical + vbRetryCancel,
"Error: Invalid Date")
End If
BeginDate = DateValue(BeginDate)
' Converts to date format
Loop While Msg = vbRetry
Do
Msg = vbOK
EndDate = Application.InputBox("Enter Ending Date from column J:",
"Range Ending", Type:=1)
If Not IsDate(EndDate) Then
' Checks to see if entry is a date
Msg = MsgBox("Entry not a valid date!", vbCritical + vbRetryCancel,
"Error: Invalid Date")
End If
EndDate = DateValue(EndDate)
' converts to date format
Loop While Msg = vbRetry
' -------------------------
MsgBox "You selected: " & BeginDate & " through " & EndDate & " ", ,
"Select Range"
' Do something with the date values
On Error GoTo Finish
' Fill in the selected cells in Column N with, skip dates Ranges not
selected...
Rng.AutoFilter Field:=1, Criteria1:=">=" & CLng(BeginDate),
Operator:=xlAnd, Criteria2:="<=" & CLng(EndDate)
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)
Rng.Offset(0, 4).FormulaR1C1 =
"=NETWORKDAYS(RC[-4],RC[-3],R2C3:R9C3)-1"
Rng.AutoFilter
' Make sure Holidays are discounted for that day, R2C3:R9C3
' Do Number coloring as a Visual Step...
Set c = Range("N11:N" & LastRow)
For Each Item In c
If Val(Item) > 2 Or Val(Item) < 0 Then
Item.Font.Bold = True
Item.Font.COLOR = vbRed
Else
Item.Font.Bold = True
Item.Font.COLOR = vbBlack
End If
Next Item
Set c = Range("N11:N" & Range("N65536").End(xlUp).Row)
For Each Item In c
If Val(Item) < -20000 Or Val(Item) > 20000 Then
Item.Value = "Missing Date!"
Else
End If
Next Item
Finish:
End Sub
script was pasted, and it works, if you see any wrapped lines, it's due
to formatting in the google post.. thanks
column J, and then it does the rest.
Script works, no problem..
After the two sets of dates are entered for the range of column J, it
confirms the date Ranges, user clicks OK and then it goes on to the
next step.
I want it to change so that, If I enter let's say:
starting range: 1/1/2005
ending range: 3/1/2005 (from column J)
it would confirm the dates like it does now, but after the user pressed
ok, it would stop the script and pop-out a box saying:
Calculation can't be performed, missing Dates in selected Range..
Can Anyone help ?
Sub Main()
Dim LastRow As Long
Dim Rng As Range
Dim Msg As Integer
Dim BeginDate As Date
Dim EndDate As Date
Dim c As Range
Dim Item As Range
LastRow = Range("J11").End(xlDown).Row
Set Rng = Range("J11:J" & Range("J65536").End(xlUp).Row)
Do
Msg = vbOK
BeginDate = Application.InputBox("Enter Starting Date from column J:",
"Range Beginning", Type:=1)
If Not IsDate(BeginDate) Then
' Checks to see if entry is a date
Msg = MsgBox("Entry not a valid date!", vbCritical + vbRetryCancel,
"Error: Invalid Date")
End If
BeginDate = DateValue(BeginDate)
' Converts to date format
Loop While Msg = vbRetry
Do
Msg = vbOK
EndDate = Application.InputBox("Enter Ending Date from column J:",
"Range Ending", Type:=1)
If Not IsDate(EndDate) Then
' Checks to see if entry is a date
Msg = MsgBox("Entry not a valid date!", vbCritical + vbRetryCancel,
"Error: Invalid Date")
End If
EndDate = DateValue(EndDate)
' converts to date format
Loop While Msg = vbRetry
' -------------------------
MsgBox "You selected: " & BeginDate & " through " & EndDate & " ", ,
"Select Range"
' Do something with the date values
On Error GoTo Finish
' Fill in the selected cells in Column N with, skip dates Ranges not
selected...
Rng.AutoFilter Field:=1, Criteria1:=">=" & CLng(BeginDate),
Operator:=xlAnd, Criteria2:="<=" & CLng(EndDate)
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)
Rng.Offset(0, 4).FormulaR1C1 =
"=NETWORKDAYS(RC[-4],RC[-3],R2C3:R9C3)-1"
Rng.AutoFilter
' Make sure Holidays are discounted for that day, R2C3:R9C3
' Do Number coloring as a Visual Step...
Set c = Range("N11:N" & LastRow)
For Each Item In c
If Val(Item) > 2 Or Val(Item) < 0 Then
Item.Font.Bold = True
Item.Font.COLOR = vbRed
Else
Item.Font.Bold = True
Item.Font.COLOR = vbBlack
End If
Next Item
Set c = Range("N11:N" & Range("N65536").End(xlUp).Row)
For Each Item In c
If Val(Item) < -20000 Or Val(Item) > 20000 Then
Item.Value = "Missing Date!"
Else
End If
Next Item
Finish:
End Sub
script was pasted, and it works, if you see any wrapped lines, it's due
to formatting in the google post.. thanks