3
\$\begingroup\$

I have created an inventory management sheet for a Lodge in Africa. The general conditions of the document are that it has to be easy to use, because the people who are using it are not very computer literate. I have generated a "generic" master document where I have pre-entered the items for sale in Column A, and then left 31 pre-formatted spaces for dates across the top. The cells inside the various sheets are pre-populated with formulas for calculating total inventory, income and net profits based on deliveries and daily sales.

I have created this macro that will take this generic sheet and, based on an input of month and year, will generate a new monthly sheet which will autopopulate the dates across the top of the sheet, and will delete the columns that are not necessary based on the number of days in the month. I got help on the CmdEnter_Click portion of this code from StackOverflow. This code works; however, it is extremely clumsy and long-winded. You will note that I have relied extensively on Macro Recorder, because I am VERY new to VBA. I thank you for any input you may have.

Option Explicit
Private Sub CmboMonth_DropButtonClick()
'Populate Control
Me.CmboMonth.AddItem "January"
Me.CmboMonth.AddItem "February"
Me.CmboMonth.AddItem "March"
Me.CmboMonth.AddItem "April"
Me.CmboMonth.AddItem "May"
Me.CmboMonth.AddItem "June"
Me.CmboMonth.AddItem "July"
Me.CmboMonth.AddItem "August"
Me.CmboMonth.AddItem "September"
Me.CmboMonth.AddItem "October"
Me.CmboMonth.AddItem "November"
Me.CmboMonth.AddItem "December"
End Sub

Private Sub CmboYear_DropButtonClick()
'Populate Control
Me.CmboYear.AddItem "2015"
Me.CmboYear.AddItem "2016"
Me.CmboYear.AddItem "2017"
Me.CmboYear.AddItem "2018"
Me.CmboYear.AddItem "2019"
Me.CmboYear.AddItem "2020"
Me.CmboYear.AddItem "2021"
Me.CmboYear.AddItem "2022"
Me.CmboYear.AddItem "2023"
Me.CmboYear.AddItem "2024"
Me.CmboYear.AddItem "2025"
Me.CmboYear.AddItem "2026"
Me.CmboYear.AddItem "2027"
Me.CmboYear.AddItem "2028"
Me.CmboYear.AddItem "2029"
Me.CmboYear.AddItem "2030"
Me.CmboYear.AddItem "2031"
Me.CmboYear.AddItem "2032"
Me.CmboYear.AddItem "2033"
Me.CmboYear.AddItem "2034"
Me.CmboYear.AddItem "2035"
End Sub

Private Sub CmdEnter_Click()
Dim Days As Integer
Dim StartDate As Date

    StartDate = CDate("1-" & CmboMonth.Value & "-" & CmboYear.Value)
    Days = (DateDiff("d", StartDate, DateAdd("m", 1, StartDate))) - 1

'Duplicate Sheet
Sheets(Array("Daily Sales", "Total Inventory", "Deliveries", "Income 
Statement", "Profits")).Copy
        'Fill Dates in Daily Sales
            Sheets("Daily Sales").Activate
        'Enter combo boxes into first cell
            Range("B6").Select
            ActiveCell = StartDate
        'Fill in Month Dates
            Selection.AutoFill Destination:=Range(Cells(6, 2), Cells(6, 2 
+ Days)), Type:=xlFillValues
        'Auto-Size Columns
            Cells.Select
            Cells.EntireColumn.AutoFit
            '
        'Fill Dates in Total Inventory
            Sheets("Total Inventory").Activate
        'Enter combo boxes into first cell
            Range("C5").Select
            ActiveCell = StartDate
        'Fill in Month Dates
            Selection.AutoFill Destination:=Range(Cells(5, 3), Cells(5, 3 
+ Days)), Type:=xlFillValues
        'Last day of last month
            Range("B5").Select
            ActiveCell = StartDate - 1
        'Auto-Size Columns
            Cells.Select
            Cells.EntireColumn.AutoFit
            '
        'Fill Dates in Deliveries
            Sheets("Deliveries").Activate
        'Enter combo boxes into first cell
            Range("B6").Select
            ActiveCell = StartDate
        'Fill in Month Dates
            Selection.AutoFill Destination:=Range(Cells(6, 2), Cells(6, 2   
+ Days)), Type:=xlFillValues
        'Auto-Size Columns
            Cells.Select
            Cells.EntireColumn.AutoFit
            '
        'Fill Dates in Income Statement
            Sheets("Income Statement").Activate
        'Enter combo boxes into first cell
            Range("C4").Select
            ActiveCell = StartDate
        'Fill in Month Dates
            Selection.AutoFill Destination:=Range(Cells(4, 3), Cells(4, 3 
+ Days)), Type:=xlFillValues
        'Auto-Size Columns
            Cells.Select
            Cells.EntireColumn.AutoFit
            '
        'Fill Dates in Profits
            Sheets("Profits").Activate
        'Enter combo boxes into first cell
            Range("E4").Select
            ActiveCell = StartDate
        'Fill in Month Dates
            Selection.AutoFill Destination:=Range(Cells(4, 5), Cells(4, 5 
+ Days)), Type:=xlFillValues
        'Auto-Size Columns
            Cells.Select
            Cells.EntireColumn.AutoFit

        'Delete extra columns
            Select Case Me.CmboMonth.Value
            Case "February"
                Select Case Me.CmboYear.Value
                Case "2016"
                    Sheets("Daily Sales").Select
                    Columns("AE:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Total Inventory").Select
                    Columns("AF:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Deliveries").Select
                    Columns("AE:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Income Statement").Select
                    Columns("AF:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Profits").Select
                    Columns("AH:AI").Select
                    Selection.Delete Shift:=xlToLeft
                Case "2020"
                    Sheets("Daily Sales").Select
                    Columns("AE:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Total Inventory").Select
                    Columns("AF:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Deliveries").Select
                    Columns("AE:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Income Statement").Select
                    Columns("AF:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Profits").Select
                    Columns("AH:AI").Select
                    Selection.Delete Shift:=xlToLeft
                Case "2024"
                    Sheets("Daily Sales").Select
                    Columns("AE:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Total Inventory").Select
                    Columns("AF:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Deliveries").Select
                    Columns("AE:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Income Statement").Select
                    Columns("AF:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Profits").Select
                    Columns("AH:AI").Select
                    Selection.Delete Shift:=xlToLeft
                Case "2028"
                    Sheets("Daily Sales").Select
                    Columns("AE:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Total Inventory").Select
                    Columns("AF:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Deliveries").Select
                    Columns("AE:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Income Statement").Select
                    Columns("AF:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Profits").Select
                    Columns("AH:AI").Select
                    Selection.Delete Shift:=xlToLeft
                Case "2032"
                    Sheets("Daily Sales").Select
                    Columns("AE:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Total Inventory").Select
                    Columns("AF:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Deliveries").Select
                    Columns("AE:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Income Statement").Select
                    Columns("AF:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Profits").Select
                    Columns("AH:AI").Select
                    Selection.Delete Shift:=xlToLeft
                Case Else
                    Sheets("Daily Sales").Select
                    Columns("AD:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Total Inventory").Select
                    Columns("AE:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Deliveries").Select
                    Columns("AD:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Income Statement").Select
                    Columns("AE:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Profits").Select
                    Columns("AG:AI").Select
                    Selection.Delete Shift:=xlToLeft
                End Select
            Case "April"
                    Sheets("Daily Sales").Select
                    Columns("AF:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Total Inventory").Select
                    Columns("AG:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Deliveries").Select
                    Columns("AF:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Income Statement").Select
                    Columns("AG:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Profits").Select
                    Columns("AI:AI").Select
                    Selection.Delete Shift:=xlToLeft
                Case "June"
                    Sheets("Daily Sales").Select
                    Columns("AF:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Total Inventory").Select
                    Columns("AG:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Deliveries").Select
                    Columns("AF:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Income Statement").Select
                    Columns("AG:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Profits").Select
                    Columns("AI:AI").Select
                    Selection.Delete Shift:=xlToLeft
                Case "September"
                    Sheets("Daily Sales").Select
                 Columns("AF:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Total Inventory").Select
                    Columns("AG:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Deliveries").Select
                    Columns("AF:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Income Statement").Select
                    Columns("AG:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Profits").Select
                    Columns("AI:AI").Select
                    Selection.Delete Shift:=xlToLeft
                Case "November"
                    Sheets("Daily Sales").Select
                    Columns("AF:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Total Inventory").Select
                    Columns("AG:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Deliveries").Select
                    Columns("AF:AF").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Income Statement").Select
                    Columns("AG:AG").Select
                    Selection.Delete Shift:=xlToLeft
                    Sheets("Profits").Select
                    Columns("AI:AI").Select
                    Selection.Delete Shift:=xlToLeft
                Case Else
        End Select


    'Save As
    ActiveWorkbook.SaveAs Filename:= _
    "Address" & CmboMonth.Value & 
 CmboYear.Value, FileFormat:= _
    xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'Close Userform
Unload Me

End Sub

Private Sub CmdCancel_Click()
'Close Userform
Unload Me
End Sub
\$\endgroup\$
0

2 Answers 2

5
\$\begingroup\$

The first thing to note is that you populate the combo boxes each time they're clicked. There's no need to do it each and every time. You can do it once on the UserForm_Intialize event.

Private Sub UserForm_Initialize()

    InitializeMonthsCombo
    InitalizeYearsCombo

End Sub

There's also a trick or two to slim down the amount of code you need to populate their values. For the "years" box, you're adding each year between a start year and an end year. We can populate this using a loop.

Private Sub InitalizeYearsCombo()

    Const startYear As Integer = 2015
    Const endYear As Integer = 2035

    Dim i As Integer
    For i = startYear To endYear
        Me.CmboYear.AddItem i
    Next

End Sub

We can use a similar method for the months, but first, we need to populate a string array so that we have something to loop over.

Private Sub InitializeMonthsCombo()

    Dim months() As String
    months = Split("January,Februrary,March,April,May,June,July,August,September,October,November,December", ",")

    Dim i As Integer
    For i = LBound(months) To UBound(months)
        Me.CmboMonth.AddItem months(i)
    Next

End Sub

The next thing to do is start Avoiding Activate and Select. We should always default to explicitly referencing objects instead. For example, this snippet

'Fill Dates in Daily Sales
    Sheets("Daily Sales").Activate
'Enter combo boxes into first cell
    Range("B6").Select
    ActiveCell = StartDate

could be re-written like so.

Sheets("Daily Sales").Range("B6").Value = StartDate

But we'll need to go a bit farther in order to really clean up your code. Let's declare a variable for the Daily Sales worksheet. This is because once we stop Selecting/Activating, we can no longer use the plain Cells object which implicitly refers to the active sheet.

This

    'Fill Dates in Daily Sales
        Sheets("Daily Sales").Activate
    'Enter combo boxes into first cell
        Range("B6").Select
        ActiveCell = StartDate
    'Fill in Month Dates
        Selection.AutoFill Destination:=Range(Cells(6, 2), Cells(6, 2 + Days)), Type:=xlFillValues
    'Auto-Size Columns
        Cells.Select
        Cells.EntireColumn.AutoFit

Becomes this

    Dim dailySales As Worksheet
    Set dailySales = Worksheets("Daily Sales")

    Dim rng As Range
    Set rng = dailySales.Range("B6")

    rng.Value = StartDate
    rng.AutoFill Destination:=Range(dailySales.Cells(6, 2), dailySales.Cells(6, 2 + Days)), Type:=xlFillValues

    dailySales.Cells.EntireColumn.AutoFit

Which allows us to extract all of the duplicated code out into a subroutine of it's own.

Public Sub Populate(destSheet As Worksheet, first As Range, dest As Range)

    first.Value = StartDate
    first.AutoFill Destination:=dest, Type:=xlFillValues

    destSheet.Cells.EntireColumn.AutoFit

End Sub

Which reduces each call to just a couple of lines of code.

Dim dailySales As Worksheet
Set dailySales = Worksheets("Daily Sales")

Populate dailySales, dailySales.Range("B6"), dailySales.Range(dailySales.Cells(6, 2), dailySales.Cells(6, 2 + Days))

Dim totalInventory As Worksheet
Set totalInventory = Worksheets("Total Inventory")

Populate totalInventory, totalInventory.Range("C6"), totalInventory.Range(totalInventory.Cells(5, 3), totalInventory.Cells(5, 3 + Days))

I would probably go one step farther and create a function to return this range based off of the hard coded numbers and number of days. This logic also gets repeated a lot.

totalInventory.Range(totalInventory.Cells(5, 3), totalInventory.Cells(5, 3 + Days))

I'll leave it as an exercise for you to apply these concepts to your Select Case block and encourage you to come back and post a follow up question once you've cleaned the code up a bit.

\$\endgroup\$
2
  • 1
    \$\begingroup\$ This is so brilliant! It works perfectly! Two things have occurred to me though: 1. Is there a way to make the years just automatically go on adding the next year to the dropdown forever? I have filled in a number of years, but I chose that number arbitrarily. And 2. I am now thinking about how to delete the extra columns at the end. Is there a function I could put under the "Populate XXXX, XXXX.Range...." line where I use .Cells(,2+Days), .Cells("AF") as a range to delete columns? I have been trying to do that, but to no avail. Thank you again though! \$\endgroup\$
    – Meringue90
    May 12, 2015 at 17:14
  • 2
    \$\begingroup\$ 1. Sure. Calculate this year and x years into the future. Look at the VBA.DateTime functions. 2. I'm sure there is, but you'll likely need to work with the column index as a number rather than an alpha character "range". \$\endgroup\$
    – RubberDuck
    May 12, 2015 at 23:07
2
\$\begingroup\$

Your combo boxes are populating themselves when the user clicks ("drops") them ...everytime the user clicks them.

Since their data isn't going to change throughout the lifetime of the form, you should populate them once, when the form is shown - use the UserForm_Initialize handler for that.

To populate the month names dropdown, you could use a For...Next loop to count from 1 to 12, and use the MonthName function to get the name for the current iteration. Something like this:

For i = 1 To 12
    CmboMonth.AddItem MonthName(i)
Next

Same for the years:

For i = 2015 To 2035
    CmboYear.AddItem CStr(i)
Next

I don't have time right now to dig much deeper, but I'm pretty sure someone will come along and help you melt that last procedure :)

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.