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
Related
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
I attached my table. I want to get date(In inputbox) from Column A and D
and copy the adjacent cell value (Column B and E). Then paste in different cell.
For eg. if i enter date 15.10.2016 and 25.10.2017. Then output must be as shown in figure. If the date is not present in the column then Msgbox as invalid date. Help me
This quick method would work for you.
Sub get_money()
a_col_last_row = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
d_col_last_row = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 4).End(xlUp).Row
data_a = InputBox("Enter 1st date")
data_d = InputBox("Enter 2st date")
lookup_val_a = ThisWorkbook.Worksheets(1).Cells(3, 8)
Dim refRng_a As Range
Dim refRng_d As Range
Set refRng_a = Range("A2:B" & a_col_last_row)
'data_a = Cells(3, 8).Value
Set refRng_d = Range("D2:E" & d_col_last_row)
'data_d = Cells(3, 9).Value
On Error GoTo errhandler1:
Cells(3, 8) = WorksheetFunction.VLookup(data_a, refRng_a, 2, 0)
controlback:
On Error GoTo errhandler2:
Cells(3, 9) = WorksheetFunction.VLookup(data_d, refRng_d, 2, 0)
End
errhandler1:
MsgBox "1st Value not found"
Err.Number = 0
Resume controlback
errhandler2:
MsgBox " 2nd Value not found"
Err.Number = 0
End Sub
However please note that I have used the same Range (H3, I3) for input as well as output. I thought you want it that way. You may change it according to your need.
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!
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.
Trying to do an insert if formula in VBA for the following;
In my column K I want three conditions:
Date is Today or older (ie project is due today or earlier) = RED
Date is Today + up to 7 days = Amber
Date is Today less more than 7 days = Green
I was thinking of using something along the lines of:
Sub ChangeColor()
lRow = Range("K" & Rows.Count).End(xlUp).Row
Set MR = Range("K3:K" & lRow)
For Each cell In MR
If cell.Value = "TODAY" Then cell.Interior.ColorIndex = 10
If cell.Value = "TODAY-7days" Then cell.Interior.ColorIndex = 9
If cell.Value = "Morethan7Days" Then cell.Interior.ColorIndex = 8
Next
End Sub
I've been trying but I'm not sure how to do it.
I think my way is correct yet I am not sure how to code the If date=-7days then and so on.
Can someone provide some guidance? :)
VBA has a Date function that returns today's date. Dates in VBA are the number of days since December 31, 1900 (usually and with a leap year bug), so you can subtract or add integers to Date to get past and future days.
Sub ChangeColor()
Dim rCell As Range
With Sheet1
For Each rCell In .Range("K3", .Cells(.Rows.Count, 11).End(xlUp)).Cells
If rCell.Value <= Date Then
rCell.Interior.Color = vbRed
ElseIf rCell.Value <= Date + 7 Then
rCell.Interior.Color = vbYellow
Else
rCell.Interior.Color = vbGreen
End If
Next rCell
End With
End Sub
Mr. Anderson is correct that you could accomplish this with conditional formatting however if you want to do this in VBA Create a variable to hold the date and set it to the current day minus the time. Then you just want to Format the cells value to a date format. Once this is done you can use dateAdd to and and subtract the days. See below
Sub ChangeColor()
Dim myDate As Date
'format the date excluding time
myDate = FormatDateTime(Now, 2)
lRow = Range("K" & Rows.Count).End(xlUp).Row
Set MR = Range("K3:K" & lRow)
For Each cell In MR
If FormatDateTime(cell.Value, 2) = myDate Then cell.Interior.ColorIndex = 10
If FormatDateTime(cell.Value, 2) = DateAdd("d", -7, myDate) Then cell.Interior.ColorIndex = 9
If FormatDateTime(cell.Value, 2) = DateAdd("d", 7, myDate) Then cell.Interior.ColorIndex = 8
Next
End Sub
I did notice that your checking to see if it is equal so only dates that are exactly Todays date, 7 days from today and 7 days previous to today will have the interior color filled. greater than and less than to fill all interior cell colors
Sorry for all the edits