Case statement nested in WITH Statement not selecting a case - vba

I am trying to set cell "H2" to either "Shift 1" , "Shift 2" or "Shift 3" depending on the inputted time value found in Cell D2 of my workbook, here is a screenshot example:
So Cell H2 is Shift 1 because it's within a Timevalue of Case TimeValue("11:21 PM") To TimeValue("7:20 AM")
Here is the code, it executes but doesn't select a case and I can't figure out my mistake. Also, if there is anyway to execute these 3 case statements within the With statement as I set the time input in cell "D2" inside of that with statement I would appreciate that!
.Range("D2").Value = Now 'Inputs the Time Value as the current Time
.Range("D2").NumberFormat = "h:mm:ss AM/PM" 'Formats the Time value as a Time entry
The code can be found below:
Sub ReportGeneratorTest()
Application.ScreenUpdating = False 'This speeds up the macro by hiding what the macro is doing
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set wb3 = Workbooks.Open(Filename:="\\Report Generator\SetupSheet Report Generator.xlsm") 'Sets the Workbook variable as the database filepath
With wb3.Sheets("All Requests Sheet 1") 'With the "Changes" sheet do the following
.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts a new row in [3] with the same format as below
.Range("A2").Value = Sheet1.Range("K112").Value 'Inputs the typed in Operator name into the Report Generator
.Range("B2").Value = Sheet1.Range("H4").Value 'Inputs the "Key" inside cell "A" of the new row
.Range("C2").Value = Now 'Inputs the Date Submitted value as the current date
.Range("C2").NumberFormat = "dd-mmm-yyyy" 'Formats the Date Submitted value as a date entry
.Range("D2").Value = Now 'Inputs the Time Value as the current Time
.Range("D2").NumberFormat = "h:mm:ss AM/PM" 'Formats the Time value as a Time entry
.Range("E2").Value = UCase(Sheet1.Range("E4").Value) 'Inputs the Part inside Cell "D" of the new row
.Range("F2").Value = Sheet1.Range("E5").Value 'Inputs the Process inside Cell "E" of the new row
.Range("G2").Value = "IRR 200-2S"
End With
Dim T1 As Date
'T1 = Range("D2").Value
T1 = Now
'Set T1 = Range("D2").Value
Select Case T1
Case TimeValue("7:21 AM") To TimeValue("3:20 PM")
Range("H2").Value = "Shift 2"
Case TimeValue("3:21 PM") To TimeValue("11:20 PM")
Range("H2").Value = "Shift 3"
Case Else 'If the Timevalue is between TimeValue("11:21 PM") To TimeValue("7:20 AM")
Range("H2").Value = "Shift 1"
End Select
wb3.Save 'Save the database Workbook
wb3.Close False
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True 'Must be "True" after running the code to be able to Read/Write the Workbook
End Sub

Summarizing the comments into an answer:
Case TimeValue("11:21 PM") To TimeValue("7:20 AM") doesn't work because when using To, the smaller value should come first. Maybe just move the "Shift 1" logic to a Case Else.
More importantly, Now includes today's date, i.e. it has both a day and time component. To get only the time component, you could do the following:
Dim T1 As Double
T1 = Now - Date

Related

Excel VBA Chart Maximum Scale Error

Two issues with this code that I need some help on, I'm new to vba and not sure what the cause of the issues are.
First issue is that when Me.Range("L7") = Format(Me.Range("C4")....) gets formatted it puts the date in american format "mm/dd/yyyy". However, the next line Me.Range("L8") is put into the correct "dd/mm/yyyy" format?
Second issue is, when I am changing the chart maximum axis I get a type mismatch error, yet the minimum axis scale changes works perfectly fine?
Any help appreciated.
Private Sub CommandButton1_Click()
answer = MsgBox("This will prepare the workbook for the next month, are you sure?", vbYesNo)
If answer = vbNo Then Exit Sub
Range("c34") = "=DATE($B$2,$A$2,A34)" 'enters formula into cell c34
Range("a2") = Month(Date) - 1 'changes month to last month
Range("a3") = Year(Date)
If Month(Date) - 1 <> Month(Range("c34")) Then
Range("C34").Clear 'checks if last date in column is in same month, if not, clear
End If
myLR = ThisWorkbook.Sheets("Data Input").Cells(Rows.Count, 3).End(xlUp).Row 'grabs date in last row
Me.Range("L7") = Format(Me.Range("c4"), "dd/mm/yyyy") 'gets start date of month and formats it
Me.Range("L8") = Format(Me.Cells(myLR, 3).Value, "dd/mm/yyyy") 'gets last date of month and formats it
Range("K7") = "First Day of Month"
Range("K8") = "Last Day of Month"
'Chart section
Sheets("Site 5").Select
ActiveChart.ChartArea.Select
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.Axes(xlCategory).MinimumScale = Sheets("data input").Range("L7")
ActiveChart.Axes(xlCategory).MaximumScale = Sheets("data input").Range("L8")
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.NumberFormat = "d/mm/yyyy"
End Sub
It is not suitable to change cell's value by format function.
It is better to change cell's format by NumberFormatLocal.
Private Sub CommandButton1_Click()
answer = MsgBox("This will prepare the workbook for the next month, are you sure?", vbYesNo)
If answer = vbNo Then Exit Sub
Range("c34") = "=DATE($B$2,$A$2,A34)" 'enters formula into cell c34
Range("a2") = Month(Date) - 1 'changes month to last month
Range("a3") = Year(Date)
If Month(Date) - 1 <> Month(Range("c34")) Then
Range("C34").Clear 'checks if last date in column is in same month, if not, clear
End If
myLR = ThisWorkbook.Sheets("Data Input").Cells(Rows.Count, 3).End(xlUp).Row 'grabs date in last row
'Me.Range("L7") = Format(Me.Range("c4"), "dd/mm/yyyy") 'gets start date of month and formats it
Me.Range("L7") = Me.Range("c4")
Me.Range("L7").NumberFormatLocal = "dd/mm/yyyy"
'Me.Range("L8") = Format(Me.Cells(myLR, 3).Value, "dd/mm/yyyy") 'gets last date of month and formats it
Me.Range("L8") = Me.Cells(myLR, 3).Value
Me.Range("L8").NumberFormatLocal = "dd/mm/yyyy"
Range("K7") = "First Day of Month"
Range("K8") = "Last Day of Month"
'Chart section
Sheets("Site 5").Select
ActiveChart.ChartArea.Select
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.Axes(xlCategory).MinimumScale = Sheets("data input").Range("L7")
ActiveChart.Axes(xlCategory).MaximumScale = Sheets("data input").Range("L8")
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.NumberFormat = "d/mm/yyyy"
End Sub

Excel VBA Sum Data within user input date range

I'm trying to code a macro that will sum data based off a user-input date range. I've got the code worked out to get the user input range and verify that it is a date, as well as convert it to match the syntax of the headers in my data file, but I'm having trouble figuring out how to sum only the months within that date range, with the date range subject to change every time the macro is run.
Here is a screenshot of the workbook. If the user inputs 1/1/16 and 3/31/16, I need the "Sum of Qty" to be a sum of the qty for January, February and March 2016. The same needs to occur for "Sum of Cost." There are multiple tables on the same sheet where this needs to happen and more tables, months, and columns will continue to be added.
Here is a link to the file, if you'd like to see formatting: https://www.dropbox.com/s/bc5okk684livm3a/TestFile_DateSum.xlsx?dl=0
And here is my existing code:
Sub DateRange()
Dim dateString As String, TheDate As Date
Dim dateString2 As String, TheDate2 As Date
Dim valid As Boolean: valid = True
Dim valid2 As Boolean: valid2 = True
Do
dateString = Application.InputBox("Enter Start Date in xx/xx/xx format: ")
If IsDate(dateString) Then
TheDate = DateValue(dateString)
valid = True
Else
MsgBox "Invalid date"
valid = False
End If
Loop Until valid = True
Do
dateString2 = Application.InputBox("Enter End Date in xx/xx/xx format: ")
If IsDate(dateString2) Then
TheDate2 = DateValue(dateString2)
valid2 = True
Else
MsgBox "Invalid date"
valid2 = False
End If
Loop Until valid2 = True
Application.Calculation = xlManual
[C3] = TheDate
[C4] = TheDate2
StartMonth = Month(TheDate) & "/1/" & Year(TheDate)
EndMonth = Month(TheDate2) & "/1/" & Year(TheDate2)
'Application.Calculate
'Application.Calculation = xlAutomatic
End Sub
Any help would be greatly appreciated!

Delete rows based on comparing cells to user entered date and skipping blank cells

I am looking for a way to remove rows based on the termination date of an employee. I don't want blank cells to be deleted because those employees are still active. I have a text box that pops up and asks for the dates and then show the entered date. Then it is supposed to search column G for any dates prior to the entered date and delete those rows, skipping any row that is blank.
I have been searching everywhere for a way to do this but I can't get the Macro to stop deleting every row but the headers. The dates are in column G and it's about 46 rows but that can change.
Sub DateSelectandClean()
'
' DateSelectandClean Macro
' User enters date and spreadsheet deletes everything prior to that date, ignoring empty cells.
Application.ScreenUpdating = False
Dim W2Year As Date, N As Long
Dim dt As Date
W2Year = CDate(Application.InputBox(Prompt:="Please enter W2 Year as xx/xx/xxxx Date:", Type:=2))
MsgBox W2Year
N = Cells(Rows.Count, "G").End(xlUp).Row
For i = N To 2 Step -1
dt = Cells(i, 1).Value
If (Cells(i, 1).Value <> "" And dt < W2Year) Then
Cells(i, 1).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Sample Data
The main issue is you're checking the "A" column for your date info, and deleting based on that. If your dates are in "G", you should check Cells(x,7), not Cells(x,1).
Sub DateSelectandClean()
'
' DateSelectandClean Macro
' User enters date and spreadsheet deletes everything prior to that date, ignoring empty cells.
Application.ScreenUpdating = False
Dim W2Year As Date, lastRow As Long, i As Long, dateCol As Long
Dim dt As Date
dateCol = 7 ' for column G
Do While W2Year = "00:00:00"
W2Year = Format(Application.InputBox(Prompt:="Please enter W2 Year as xx/xx/xxxx Date:", Type:=2), "mm/dd/yyyy")
MsgBox W2Year
Loop
lastRow = Cells(Rows.Count, dateCol).End(xlUp).Row
For i = lastRow To 2 Step -1
'If Cells(i, dateCol).Value <> "" Then
If IsDate(Cells(i,dateCol)) Then
dt = CDate(Format(Cells(i, dateCol).Value, "mm/dd/yyyy"))
If dt <= W2Year Then
Cells(i, dateCol).EntireRow.Delete
End If
End If
Next i
Application.ScreenUpdating = True
End Sub
I also change the variables from Date to String which allows a little bit of error catching when the user inputs info. You can edit that back if you wish, I was just thinking of a time when someone puts in "wrong" or incorrectly formatted info.
Your code might be getting an issue in blank date.
I separate the IF so that it won't continue the validation on date.
e.g. IF "" < #01/01/2017#
Try this, not much changes though:
Sub DateSelectandClean()
' DateSelectandClean Macro
' User enters date and spreadsheet deletes everything prior to that date, ignoring empty cells.
Application.ScreenUpdating = False
Dim dateCol, iRow
Dim W2Year As Date, N As Long
Dim dt As String
W2Year = CDate(Application.InputBox(Prompt:="Please enter W2 Year as dd/mm/yyyy Date:", Type:=2))
MsgBox W2Year
N = Cells(Rows.Count, "G").End(xlUp).Row
dateCol = 7
For iRow = N To 2 Step -1
dt = Cells(iRow, dateCol).Value
If (Cells(iRow, dateCol).Value <> "") Then
If (CDate(dt) < CDate(W2Year)) Then
Cells(iRow, dateCol).EntireRow.Delete
End If
End If
Next
Application.ScreenUpdating = True
End Sub

Stuck with multiple conditions and comparing strings

I have code which creates a summary table from a bunch of excel files. The code copies and uses xlPasteSpecialOperationAdd to paste the selected range from each files to a temporary sheet.
The summary table has 2 input cells which determines the conditions. The 1st cell contains the statuses which can be [ALL, 0,1,2,3,4,5]. The 2nd field is the date in yyyy/mm/dd format.
The first cell recommended to fill, the second is optional. If the 2nd cell is empty then the date is doesn’t matter.
I think I have some trouble comparing the dates or probably the conditions incorrect. For comparing the dates I used two functions: LIKE and StrComp, but none of them worked or maybe because of the incorrect condition.
Please help me how to fix this code:
Set input cell text to string variable (2016.07 = 7 chars with dots):
'Get input date as string
AstrDate = OutputWs.Range("P5").Text
'Set the date to year and month format
AstrDateChars = Left$(strDate, 7)
Decide if the cell is blank:
'if the input range is blank then rangeBlank is true
If IsEmpty(OutputWs.Range("P5")) = True Then
rangeBlank = True
Else
rangeBlank = False
End If
'Get the output date to compare with
BstrDate = oNewBook.Sheets(1).Range("R22").Text
Get the output value:
'Set the compared date to year and month format
BstrDateChars = Left$(strDate, 7)
Comparing with StrComp function and store value into a boolean variable:
'compare date strings
'compareResult = StrComp(AstrDateChars, BstrDateChars, vbBinaryCompare)
Comparing with Like function:
compareResult = AstrDateChars Like BstrDateChars
The conditions:
'Which IL status you want to copy?
If inputValue = "ALL" And rangeBlank = True Then 'Search for all IL status
oNewBook.Worksheets(1).Range("G25:N28").Copy
tempWS.Range("G25:N28").PasteSpecial Paste:=xlPasteAll, operation:=xlPasteSpecialOperationAdd
oNewBook.Close
ElseIf inputValue = outputValue And rangeBlank = True Then 'Search for only the selected IL status
oNewBook.Worksheets(1).Range("G25:N28").Copy
tempWS.Range("G25:N28").PasteSpecial Paste:=xlPasteAll, operation:=xlPasteSpecialOperationAdd
oNewBook.Close
ElseIf inputValue = "ALL" And rangeBlank = False And compareResult = True Then 'Searcg ALL IL status and date
oNewBook.Worksheets(1).Range("G25:N28").Copy
tempWS.Range("G25:N28").PasteSpecial Paste:=xlPasteAll, operation:=xlPasteSpecialOperationAdd
oNewBook.Close
ElseIf inputValue = "ALL" And rangeBlank = False And compareResult = False Then 'Searcg ALL IL status and date, If date does not match, then closes the document
oNewBook.Close
ElseIf inputValue = outputValue And rangeBlank = False And compareResult = True Then 'Search for the selected IL0-IL5 and date
oNewBook.Worksheets(1).Range("G25:N28").Copy
tempWS.Range("G25:N28").PasteSpecial Paste:=xlPasteAll, operation:=xlPasteSpecialOperationAdd
oNewBook.Close
ElseIf inputValue = outputValue And rangeBlank = False And compareResult = False Then 'Search for the selected IL0-IL5 and date, if date does not match, then closes the document
oNewBook.Close
End If
Try this for StrComp:
compareResult = (StrComp(AstrDateChars, BstrDateChars, vbBinaryCompare)=0)

Select sheet defined as date

I do have a workbook where multiple sheets are named based on date (in format MMDDD). This macro should loop trough all date sheet (like 01OCT, 02OCT, .... 30OCT) select range and copy it into new sheet.
Selecting cells, copying them and so is not really problem, and that is working perfectly. However I do have a problem defining sheet name. I would like user in the beginning define month and number of days in month and month using InputBox.
So if user select month = "FEB" and DaysMonth = 28, I would like macro to loop trough sheets named 01FEB, 02FEB, 03FEB, .... 28FEB.
Sub Merge_whole_month()
Application.ScreenUpdating = False
Dim month As String
month = InputBox(Prompt:="Please enter month in format MMM", _
Title:="Month")
Dim DaysMonth As Long
DaysMonth = InputBox(Prompt:="Please enter number of days in month", _
Title:="Days")
'create new sheet for results
Sheets.Add.Name = "Merge"
'loop
For i = 1 To DaysMonth
i = Format(i, "##")
Sheets(i & month).Activate 'here is the problem
'select cell G3, then all "non-empty" cells to the right and down and COPY
Range(Range("G3", Range("G3").End(xlToRight)), Range("G3", Range("G3").End(xlToRight)).End(xlDown)).Select
Selection.Copy
Sheets("Merge").Activate 'activate sheet where cells needs to be copied
'find last cell in 2nd row in sheet
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
lastCol = lastCol + 1
Cells(1, lastCol) = i & month 'log date and month in cell above
Cells(2, lastCol).Select
ActiveSheet.Paste 'Paste
Next i
Application.ScreenUpdating = True
End Sub
Many thanks in advance for any help!
The problem lies in the facto that i = Format(i, "##") does not make i less than 10 appear as 01 etc. To fix this i would do this:
Dim sDate As String
sDate = CStr(i)
If Len(sDate) < 2 Then
sDate = "0" & sDate
End If
Place that code within your for-loop before Sheets(i & month).Activate and remove i = Format(i, "##").
EDIT:
It also seems that for me using Format(i, "0#") gives the string you were looking for. However you will still need to assign this to a String variable or change Sheets(i & month).Activate to Sheets(Format(i, "0#") & month).Activate.
Here is the documentation on the Format() function. I suggest reading it.