I have Combobox in userform for 12 months. combobox populate dates in rows according to month. I select "January" and I have 31 dates in rows.
I am trying to clear the formula (with every change of month from the rest of the rows when I select "February" (28 dates) or any month which have less than 31 dates.
The code I used is below :
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Set ws = Worksheets("Month")
With Me.cmb_mnth
.Clear
.AddItem "January"
.AddItem "February"
.AddItem "March"
.AddItem "April"
.AddItem "May"
.AddItem "June"
.AddItem "July"
.AddItem "August"
.AddItem "September"
.AddItem "October"
.AddItem "November"
.AddItem "December"
.ListIndex = 9
End With
End Sub
Private Sub cmb_mnth_Change()
Dim sh As Worksheet
Set sh = Worksheets("Month")
sh.Range("B2").Value = Me.cmb_mnth.Value
sh.Range("A1:A31").Value = "=IFERROR(TEXT(RC[3],""dddd""),"""")"
sh.Range("D1:D31").Value = "=IFERROR(IF(ROWS(R1C:RC)>DAY(EOMONTH(DATE(YEAR(TODAY()),MONTH(R2C2&1),1),0)),"""",DATE(YEAR(TODAY()),MONTH(R2C2&1),ROW(Sheet4!RC[2]))),"""")"
sh.Range("E1:E31").Value = "=IFERROR(DAY(RC[-1]),"""")"
End Sub
First clear the range like FaneDuru showed you
then get the correct daycount with:
Public Function GetDayCountOfMonth(year As Long, month As Long) As Long
GetDayCountOfMonth = Day(DateSerial(year, month + 1, 0))
End Function
you would call it with
x = GetDayCountOfMonth(2022,cmb_mnth.listindex + 1) ' 2022 yor year
And then you fill the range accordingly
sh.Range("A1:A" & x).Value ' that is not really best better with cells but ...
Or you go the other way and fill the range like bevor and clear the range 31-x rows
Related
I have a userform that askes to which month the data input is applicable. I have used a combibox with jan, feb, mar etc as possible answers.
Now I want to use these answers to refer to a sheet index number Jan is sheets(2), feb = sheets(3) etc.
How do I do this?
Private Sub Userform_Initialize()
'Empty maandbox1
MultiPage1.Value = 0
Maandbox.Value = ""
With Maandbox
.AddItem "Jan"
.AddItem "Feb"
.AddItem "Mar"
'etc
End With
'Set Focus on Monthbox
Maandbox.SetFocus
End Sub
And then something like:
dim ws as worksheet
dim i as integer
i = Monthbox.Value
Set ws = ActiveWorkbook.Worksheets(i + 1)
i = Monthbox.Listindex + 2
should do the trick, since the listindex starts at 0.
You could use MonthName(). It takes a Long value and it returns its month. Thus, 1 is January, 2 is February and etc. To get the first three letters of the month use Left(value, 3):
Public Sub TestMe()
Dim cnt As Long
For cnt = 1 To 12
Debug.Print MonthName(cnt)
Debug.Print Left(MonthName(cnt), 3)
Next cnt
End Sub
In your case:
Dim ws As Worksheet
Dim i As Long
i = Monthbox.Value
Set ws = ActiveWorkbook.Worksheets(Left(MonthName(cnt + 1), 3))
You can use the DateValue function to return a dummy date and pull the integer month number from there:
Dim dt as Date, i as Long
dt = DateValue(Maandbox.Value & " 1," & Format(Now(),"YYYY"))
i = Format(dt, "M") + 1
I usually just set the date to the first of the month. The Format(Now(),"YYYY") simply turns the current day's date into a year to complete the DateValue function parameters. I have found this method flexible because it creates a date that you can now format however else you need it. For instance, if you need the full month description, you now have the option of doing:
RunMonth = Format(dt, "MMMM")
since it's been saved in your variable.
I have the following problem: I try to filter a date column (A) in a worksheet (HISTORICALS) to return the highest and second highest date value. Currently, there is dates ranging from the 25th to the 31st of December in this column. Unfortunately, below formula (using the Large function) returns the 31st two times (and not the 30th and 31st as intended).
Sub Select_Last_Two_Days()
With Worksheets("HISTORICALS")
Highest_Max = Format(WorksheetFunction.Large(Worksheets("HISTORICALS").Range("A:A"), 1), "Short Date")
Second_Highest_Max = Format(WorksheetFunction.Large(Worksheets("HISTORICALS").Range("A:A"), 2), "Short Date")
Debug.Print Highest_Max, Second_Highest_Max
End With
End Sub
The column has approx. 2000 rows, with dates occuring multiple times. So ideally I would want to filter for distinct values and then return the two highest dates. Any idea how I can do that?
Simply translate Barry Houdinis answer from How to find the first and second maximum number? to VBA:
Sub Select_Last_Two_Days()
With Worksheets("HISTORICALS")
Highest_Max = Format(WorksheetFunction.Max(.Range("A:A")), "Short Date")
Second_Highest_Max = Format(WorksheetFunction.Large(.Range("A:A"), WorksheetFunction.CountIf(.Range("A:A"), WorksheetFunction.Max(.Range("A:A"))) + 1), "Short Date")
Debug.Print Highest_Max, Second_Highest_Max
End With
End Sub
The recommendations given in the comments are probably the simplest and least amount of code way to do things but here is another sugggestion:
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("HISTORICALS")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim loopArr()
loopArr = ws.Range("A1:A" & lastRow).Value
Dim maxVal As Date
maxVal = Application.WorksheetFunction.Large(ws.Range("A1:A" & lastRow), 1)
Dim i As Long
Dim secondVal As Date
For i = UBound(loopArr, 1) To LBound(loopArr, 1) Step -1
If loopArr(i, 1) < maxVal Then
secondVal = loopArr(i, 1)
Exit For
End If
Next i
End Sub
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
New to this, only been doing it around 24 hours. 12 of those hours have been researching this problem. I have found so many pages with examples that seem like they SHOULD work, but haven't. I must be missing sth blatantly obvious.
My code:
opens a msgbox, with which the user chooses (types in) an existing worksheet. Currently there is only one worksheet, C1.
the macro then uses a vlookup to find a the value in a cell, which is stored in a variable for later use. The cell I'm trying to find contains 2016.1. It is located in Cell C25 of sheet C1.
The problem is the vlookup. I get "runtime error 1004: Unable to get the VLookup property of the WorksheetFunction class".
I know my variables Prodcode contains the correct sheet name (C1), and ForecastYear contains the correct year (2016.1). I think my issue is that I'm not referencing the worksheet name somehow, but I've tried to follow examples from so many websites, and none of them work.
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function
Private Sub UserForm_Initialize()
Dim ProdCode As String
Do Until WorksheetExists(ProdCode)
ProdCode = InputBox("Enter Product Code: ", "Enter Product Code:", "i.e C1")
If Not WorksheetExists(ProdCode) Then MsgBox ProdCode & _
" doesn't exist!", vbExclamation
Loop
Sheets(ProdCode).Select
Me.Title.Caption = "Forecast data for " & ProdCode
Me.Label2012.Caption = Format(Now(), "yyyy")
Me.Label1sta.Caption = "1st Qtr"
Me.Label2nda.Caption = "2nd Qtr"
Me.Label3rda.Caption = "3rd Qtr"
Me.Label4tha.Caption = "4th Qtr"
Me.LabelFc1.Caption = "Forecast"
Me.Labelwfc1.Caption = "Weighted Forecast"
Me.LabelwD1.Caption = "Weighted Demand"
'-----------------------------------------------------------------------------
'1st quarter current year predictions
Dim ForecastYear As Double
ForecastYear = Year(Now) + .1 'the .1 is to break the year into quarters
MsgBox (ForecastYear) 'for debugging only. checks the correct year is selected
MsgBox (ProdCode) 'for debugging only. checks the correct worksheet is selected
Dim Forecast As Double
Forecast = Application.WorksheetFunction.VLookup(ForecastYear, _
Sheets(ProdCode).Range("A9:J5000"), 10, False)
Forecast = Round(Forecast, 2)
'-----------------------------------------------------------------------------
With ListBox1
.AddItem ForecastYear
.AddItem Forecast
.AddItem ""
End With
End Sub
Sorry, I know this has likely been asked before. I may have even stared at the answer on another page and not realised it was the answer.
I guess you have to change:
Dim Forecast As Double
Forecast = Application.WorksheetFunction.VLookup(ForecastYear, Sheets("ProdCode").Range("A9:J5000"), 10, False)
Forecast = Round(Forecast, 2)
'-----------------------------------------------------------------------------
With ListBox1
.AddItem ForecastYear
.AddItem Forecast
.AddItem ""
End With
to:
Dim Forecast As Variant
Forecast = Application.VLookup(ForecastYear, Sheets(ProdCode).Range("A9:J5000"), 10, False)
If IsError(Forecast) Then
MsgBox "couldn't find '" & ForecastYear & "' in Sheets '" & ProdCode & "'"
Exit Sub
End If
Forecast = Round(Forecast, 2)
'-----------------------------------------------------------------------------
With ListBox1
.AddItem ForecastYear
.AddItem Forecast
.AddItem ""
End With
Furthermore I'd refactor the initial ProdCode loop to:
ProdCode = Application.InputBox("Enter Product Code: ", "Enter Product Code:", "i.e C1", , , , , 2)
Do While Not WorksheetExists(ProdCode)
MsgBox ProdCode & " doesn't exist!", vbExclamation
ProdCode = Application.InputBox("Enter Product Code: ", "Enter Product Code:", "i.e C1", , , , , 2)
Loop
I have a little problem with my VBA code. I use the code below to display every date in a date range. So if the date range is 3 Dec - 5 Dec, it will display 3 Dec in cell E10, 4 Dec in cell E11 and 5 Dec in cell E12. This works fine, however I need to add 4 blank cells below every date (so 3 Dec will be in cell E10, but the 4th of December will be shown in cell E15 etc).
Private Sub cmdOK_Click()
Dim RowCount As Long
Dim ctl As Control
' Check user input
If Me.SdPicker.Value = "" Then
MsgBox "Please enter an start date.", vbExclamation, "Start data error"
Me.SdPicker.SetFocus
Exit Sub
End If
If Me.EdPicker.Value = "" Then
MsgBox "Please enter the end date.", vbExclamation, "End date error"
Me.EdPicker.SetFocus
Exit Sub
End If
' Write data to worksheet
With Worksheets("Projection_Daily").Range("X1")
.Value = Me.SdPicker.Value
End With
With Worksheets("Projection_Daily").Range("Y1")
.Value = Me.EdPicker.Value
End With
' Close the form to open Output sheet and implement date range
Worksheets("Projection_Daily").Activate
Worksheets("Projection_Daily").Columns(5).ClearContents
Dim StartDate As Date
Dim EndDate As Date
Dim NoDays As Integer
StartDate = Worksheets("Projection_Daily").Range("X1").Value
EndDate = Worksheets("Projection_Daily").Range("Y1").Value
NoDays = EndDate - StartDate + 4
Worksheets("Projection_Daily").Range("E10").Value = StartDate
Worksheets("Projection_Daily").Range("E10").Resize(NoDays).DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, Stop:=EndDate, Trend:=False
Unload Me
End Sub
This is the code I currently use, I have tried to insert .Offset(4,0) to the code but with no luck. I hope you can help me with this.
Thanks!
Try using a Loop condition like this:
i = 1 'To loop through the no of days
j = 10 'To start from row no 10
For i = 1 To NoDays 'Nodays = Enddate-Startdate
Sheet1.Cells(j, 5).value = StartDate
StartDate = StartDate + 1
j = j + 5 'To add a gap of 4 blank rows
Next i