Extract values within date and zone ranges

Question

In order to automate a manual task I created the following code. As I've never written a program to this size, I'm curious if my use of variables, as well as, solutions are the most optimal way for handling.

In this program, the user will choose a Year, Month, and Zone. These choices are used to narrow down Month within Year, Calendar Weeks within Month, and States within Zones. These narrowed ranges will then extract the data within those parameters and put them in the main report.

All-in-all, looking to find if there is a better use of variables, as well as, to know if these are the best methods for narrowing the ranges.

Sub TransactionCT_Reference()

Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim yRow As Variant
Dim frstMrow As Long, scndMrow As Long, _
    frstYrow As Long, scndYrow As Long, _
    frstZrow As Long, scndZrow As Long, _
    frstSrow As Long, scndSrow As Long, _
    frstCWrow As Long, scndCWrow As Long, cwCount As Long, _
    unkRow As Long, mCount As Long
Dim frstBZday As Double, frstCLday As Double, scndBZday As Double, _
    scndCLday As Double
Dim frstMname As String, scndMname As String, _
    frstZname As String, scndZname As String, _
    cwName1 As String, cwName2 As String, drName As String, unk As String
Dim mRng As Range, yRng1 As Range, yRng2 As Range, _
    zRng1 As Range, zRng2 As Range, sRng As Range, _
    cell As Range, cell2 As Range, xlsRng As Range, _
    sRng1 As Range, sRng2 As Range, sRng3 As Range, _
    dRng0 As Range, dRng13 As Range, dRng14 As Range, _
    dRng15 As Range, dRng16 As Range, dRng17 As Range, _
    dRng18 As Range, dRng19 As Range, dRng22 As Range, _
    dRng23 As Range, ws2Rng As Range

    ' Change to MASTER_Choices Cycle Time
    Set wb = Workbooks("MASTER_Choices Cycle Time - In Work VBA Changes.xlsm")
    ' Change to "03 - Data"
    Set ws = wb.Worksheets("03 - Data 2")

    ws.Activate

    'Set Year value
    yRow = ws.Cells(lastrow + 2, 5)
    ' Set Month value
    frstMname = ws.Cells(lastrow + 2, 4)
    ' Set Zone value
    frstZname = ws.Cells(lastrow + 2, 11)

    ' Dynamically find first iteration of 2015, 2016, and 2017
    On Error Resume Next
        frstYrow = Application.WorksheetFunction.Match(yRow, ws.Range("AE:AE"), 0)
        scndYrow = Application.WorksheetFunction.Match(yRow + 1, ws.Range("AE:AE"), 0)
    On Error GoTo 0

    ' Set full range of results that show year = yRow
    Set yRng1 = ws.Range("AE" & frstYrow, "AI" & scndYrow - 1)
    ' Set year column of results that show year = yRow
    Set yRng2 = ws.Range("AF" & frstYrow, "AF" & scndYrow - 1)

    If frstMname = "Jan" Then
        scndMname = "Feb"
    ElseIf frstMname = "Feb" Then
        scndMname = "Mar"
    ElseIf frstMname = "Mar" Then
        scndMname = "Apr"
    ElseIf frstMname = "Apr" Then
        scndMname = "May"
    ElseIf frstMname = "May" Then
        scndMname = "Jun"
    ElseIf frstMname = "Jun" Then
        scndMname = "Jul"
    ElseIf frstMname = "Jul" Then
        scndMname = "Aug"
    ElseIf frstMname = "Aug" Then
        scndMname = "Sep"
    ElseIf frstMname = "Sep" Then
        scndMname = "Oct"
    ElseIf frstMname = "Oct" Then
        scndMname = "Nov"
    ElseIf frstMname = "Nov" Then
        scndMname = "Dec"
    ElseIf frstMname = "Dec" Then
        scndMname = "End"
    Else
        MsgBox "No Month Found"
    End If

    ' Establish Range of Month, find first and last row of Month
    On Error Resume Next
        frstMrow = Application.WorksheetFunction.Match(frstMname, yRng2, 0)
        scndMrow = Application.WorksheetFunction.Match(scndMname, yRng2, 0)
    On Error GoTo 0

    'Within yRng1 narrow range to selected Month
    Set mRng = yRng1.Range("A" & frstMrow, "E" & scndMrow - 1)

    ' Count number of iterations of named Month within mRng
    mCount = Application.WorksheetFunction.CountIf(mRng, frstMname)

    ' Open file <Zone>.xls located in Desktop>Projects>NuGen
    Workbooks.Open Filename:="C:\Users\uswanw16\Desktop\Projects\NuGen\" & frstZname & ".xls"

    Set wb2 = Workbooks(frstZname & ".xls")
    Set ws2 = wb2.Worksheets(1)

    ws2.Activate

    ' Removing all " " from text as NG report has " " and then text
    ws2.Cells.Replace What:=" ", Replacement:=ClearContents, LookAt:=xlPart, SearchOrder:= _
    xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    ' Set Range to clear all blank cells
    unk = "Unknown"
    unkRow = Application.WorksheetFunction.Match(unk, ws2.Range("B:B"), 0)
    Set ws2Rng = ws2.Range("B1", "B" & unkRow)

    ' Copy data w/in "B:B"; Paste to ws2.Range K:K
    ws2.Range("K:K") = ws2Rng.Value
    ' Remove duplicates
    ws2.Range("K:K").RemoveDuplicates Columns:=1, Header:=xlNo

    ' Run new frstZname, scndZname to set zone zRng2
    If frstZname = "Central" Then
        scndZname = "East"
    ElseIf frstZname = "East" Then
        scndZname = "West"
    ElseIf frstZname = "West" Then
        scndZname = "Unknown"
    Else
        MsgBox "No Zone Found"
    End If

    On Error Resume Next
        frstZrow = Application.WorksheetFunction.Match(frstZname, ws2.Range("K:K"), 0)
        scndZrow = Application.WorksheetFunction.Match(scndZname, ws2.Range("K:K"), 0)
    On Error GoTo 0

    ' Establish Range of Zone, find first and last row of Zone
    Set zRng1 = ws2.Range("K" & frstZrow + 1, "K" & scndZrow - 1)

    ' Count the number of states within the zone
    zCount = Application.WorksheetFunction.CountIf(zRng1, frstZname)

    Set cell = zRng1(1, 1)

    i = 1
    k = 0

    For Each cell In zRng1
        'Narrow each range to given state
        On Error Resume Next
        Set cell = zRng1(i, 1)
            'Find state in xls
            frstSrow = Application.WorksheetFunction.Match(cell, ws2.Range("B:B"), 0)
        Set cell = zRng1(i + 1, 1)
            'Find second state in xls
            scndSrow = Application.WorksheetFunction.Match(cell, ws2.Range("B:B"), 0)
        On Error GoTo 0

        On Error Resume Next
            ' Create range State for month
            Set sRng1 = ws2.Range("C" & frstSrow, "C" & scndSrow - 1)
        On Error GoTo 0

        'Find week data and transfer to MASTER sheet
        On Error Resume Next
        For j = 1 To mCount
            Set dRng0 = ws2.Cells(100, 100)
            Set dRng13 = ws.Cells(lastrow + j + 1 + 1 + mCount * k, 1)
            Set dRng14 = ws.Cells(lastrow + j + 1 + 1 + mCount * k, 2)
            Set dRng15 = ws.Cells(lastrow + j + 1 + 1 + mCount * k, 3)
            Set dRng16 = ws.Cells(lastrow + j + 1 + 1 + mCount * k, 4)
            Set dRng17 = ws.Cells(lastrow + j + 1 + 1 + mCount * k, 5)
            Set dRng18 = ws.Cells(lastrow + j + 1 + 1 + mCount * k, 6)
            Set dRng19 = ws.Cells(lastrow + j + 1 + 1 + mCount * k, 7)
            Set dRng22 = ws.Cells(lastrow + j + 1 + 1 + mCount * k, 10)
            Set dRng23 = ws.Cells(lastrow + j + 1 + 1 + mCount * k, 11)
            'Find CW on MASTER and set to cwName1
            cwName1 = mRng(j, 3)
            'Calendar Week ##
            cwName2 = mRng(j, 4)
            ' Date Range
            drName = mRng(j, 5)
            'Find row number of cwName1 within sRng1
            'Search sRng1 to find count of mRng(j, 3)
            cwCount = Application.WorksheetFunction.CountIf(sRng1, cwName1)
            'If count of cwCount within sRng1(j, 3) > 1, then average both values
            frstCWrow = Application.WorksheetFunction.Match(cwName1, sRng1, 0)
            ' Date
            dRng13.Value = cwName1
            'Calendar Week
            dRng14.Value = cwName2
            'Date Range
            dRng15.Value = drName
            'Month
            dRng16.Value = frstMname
            'Year
            dRng17.Value = yRow
            'Biz Range - from vLookup in getEstimate Table
            'Cal Range - from vLookup in getEstimate Table
            'State
            dRng22.Value = cell(0)
            'Zone
            dRng23.Value = frstZname
            'Check to see if CW occurs more than once in range, if so average
            If cwCount > 1 Then
                Set sRng2 = sRng1.Find(What:=cwName1)
                frstBZday = sRng2.Cells(1, 2).Text
                frstCLday = sRng2.Cells(1, 3).Text
                Set sRng2 = sRng1.FindNext(sRng2)
                scndBZday = sRng2.Cells(1, 2)
                scndCLday = sRng2.Cells(1, 3)
                dRng18 = (frstBZday + scndBZday) / 2
                dRng19 = (frstCLday + scndCLday) / 2
            'If count of sRng1(j, 3) = 1, then do below:
            ' If CW ## is found in range
            ElseIf frstCWrow <> "0" Then
                Set sRng3 = sRng1.Range("A" & frstCWrow)
                'In Work - Biz Days; 18
                dRng0.Copy
                sRng3.Cells(1, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationAdd
                dRng18.Value = sRng3.Cells(1, 2)
                'In Work - Cal Days; 19
                dRng0.Copy
                sRng3.Cells(1, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationAdd
                dRng19.Value = sRng3.Cells(1, 3)
            ' If CW is not found in range
            ElseIf frstCWrow = "0" Then
                'In Work - Cal Days; 18
                dRng18.Value = "Null"
                'In Work - Cal Days; 19
                dRng19.Value = "Null"
            Else
                MsgBox "No Calendar Week Found"
            End If
            ' Reset CW in case it is not found
            frstCWrow = 0
       Next j
        On Error GoTo 0
        i = i + 1
        k = k + 1
    Next cell

    wb2.Close False

End Sub

With a public function of lastrow:

Public Function lastrow()

    Set wb = Workbooks("MASTER_Choices Cycle Time - In Work VBA Changes.xlsm")
    Set ws = wb.Worksheets("03 - Data 2")

    lastrow = ws.ListObjects("Table501").Range.Rows.Count

End Function

Answer 1

Boy is there a lot to talk about here.

First things first, if Option Explicit is not at the top of every code module, go to tools --> Options --> Require Variable declaration. This will automatically insert it from now on (I honestly have no idea why it was optional in the first place).

---

Now, I'm going to point out all the good things you're already doing:

• Explicitly declaring your variables as a type. This helps prevent all sorts of unintentional errors because the VBE will tell you when you're doing something you obviously did not intend to re: data types.

• Using _ to organise your code in a more easily-readable way.

• Decent use of comments to document/signpost the logic of your code. These could be a lot better (which I will elaborate on) but they're enough to make your current code quite easy to follow and understand.

• Actually using the VBA object model. A lot of beginner code is littered with multiple repetitions of sheets("sheet name") etc. Here, you create your worksheet/book objects and then reference those, which means if, for instance, the name of your workbook changed, you'd only have to change it in one place in your code.

• Determining values dynamically rather than hard-coding them. Having to hard-code anything is a huge source of bugs, headaches, and lost developer time for constant revisions. Anything that can be determined dynamically generally should be so thumbs up for that.

• Refactoring. You could (and should) be doing an awful lot more of this. Taking a small thing (finding the last row) and moving it into a separate procedure is the foundation of all good code. So well done there.

In short: you actually have the foundation of a lot of the concepts you need to be a great developer. Now that that's out of the way:

---

Naming

Good, informative naming is one of the most, if not the most important part of developing software. Coding is roughly 80% reading code, and only 20% writing it. And that only gets even more tilted towards reading as your code gets bigger and more complicated. As such, in almost all circumstances, the most important part of your code is how easily somebody else can understand what it's doing.

Variable names should be Descriptive, Concise and, above all, Unambiguous. And they should sound like what they are.

NONE of your variables have good names. Barely any of them have even acceptable names.

You see this?

Set dRng13 = ws.Cells(lastrow + j + 1 + 1 + mCount * k, 1)

How about this?

scndBZday = sRng2.Cells(1, 2)

Perfectly incomprehensible. If you thought one of the outputs of your code was wrong, where would you even begin trying to figure out what everything was doing?

My advice: Until you have the benefit of experience, err heavily on the side of more-verbose names. Even if it means writing variables called thingWhichRepresentsOutputOfThatThing or procedures called FunctionToDoThisThingBasedOnThatAssumption. Sure, it's a pain to write out (pro-tip, use Ctrl+space to auto-complete any declared variable names, procedures, methods etc.), and it looks messy but believe me, it'll save you (or whoever else has to maintain your code) so much trouble down the road.

Some examples:

wb1, wb2 are not good variable names. How am I suppsed to remember which is which? Especially if there's more than just 2 to keep track of. wbMasterChoices and wbDataOutput are still not great, but they're much more descriptive. Since you have more knowledge about what they actually are, you can probably think of some even better names.

frstMRow, frstYRow, frstDRow

etc. Don't abbreviate. Don't simplify. Just call them what they are firstMonthRow, firstYearRow, firstDayRow. it's only a few extra characters but it's much simpler and easier on the brain.

Don't use numbered variables. There are, occasionally, good reasons to do so. But they are rare. Off the top of your head, what piece of data does drng19 represent? How about ws2rng? Or zrng2? If you can't tell what a variable is representing just by reading its name then it's not named well enough.

Your ranges are a mess. They're crying out for some descriptive names.

yrng1, yrng2 to yearDataTable, yearIndexColumn

mRng to monthDataTable

mCount to monthRowCount

What's easier to follow?

`mCount = Application.WorksheetFunction.CountIf(mRng, frstMname)`

or

monthRowCount = Application.WorksheetFunction.CountIf(monthDataTable, firstMonthName)

Notice how I took that line completely out of context, and yet it's pretty obvious what all the variables are, what they represent and what's going on.

Added bonus: Descriptive names are very hard to mis-type. Whereas, if your finger slips and you accidentally wrote zrng when you meant to type srng, your program might give you the wrong output, and you'd spend forever trying to figure out what was going wrong, if you even realised in the first place.

---

Refactoring

The next part of writing great code is splitting your program up into small, logical bits. As a general rule, anytime you would be tempted to write a comment like

`'Find week data and transfer to MASTER sheet`

You should create a separate sub/function, pass in any parameters it needs, and then separate out your logic.

In this case, something like

Dim dataArray as variant
    dataArray = array()

dataArray = GetWeekData(arg, arg, arg)

PrintWeekDataToSheet dataArray, ws

As an example, this is the main sub for a recent project of mine.

Sub BtnSort_Click()

'/====================================================================================================
'/  Author: Zak Armstrong
'/
'/  Description:
'/  For the active sheet, finds the data Table and sortKey columns using headers.
'/  Sorts clients based on payment frequency, then payment day, then Client Name.
'/  Colours rows depending on their payment frequency.
'/====================================================================================================

    StoreApplicationSettings

    DisableApplicationSettings

        Dim ws_this As Worksheet
        Set ws_this = ActiveSheet

        Dim tableRange As Range
        Set tableRange = GetTableRange(ws_this)

        ValidateTableHeaders ws_this, tableRange

        Dim paymentFrequencyColNum As Long, paymentDayColNum As Long, clientNameColNum As Long

        FindColumnIndexes ws_this, tableRange, paymentFrequencyColNum, paymentDayColNum, clientNameColNum

        SortTableRange ws_this, tableRange, paymentFrequencyColNum, paymentDayColNum, clientNameColNum

        FormatTableRange ws_this, tableRange, paymentFrequencyColNum

    RestoreApplicationSettings

End Sub

Notice the complete lack of comments, and yet everything is absolutely clear. Generally speaking, comments should only be necessary to describe *why* you did things a certain way. Any time you find yourself writing comments to describe *what* you're doing, try to rename/refactor the code to make it redundant.

---

Other things that jump out at me

If frstMname = "Jan" Then
    scndMname = "Feb"
ElseIf frstMname = "Feb" Then
    scndMname = "Mar"
ElseIf frstMname = "Mar" Then
    scndMname = "Apr"
ElseIf frstMname = "Apr" Then
    scndMname = "May"
ElseIf frstMname = "May" Then
    scndMname = "Jun"
ElseIf frstMname = "Jun" Then
    scndMname = "Jul"
ElseIf frstMname = "Jul" Then
    scndMname = "Aug"
ElseIf frstMname = "Aug" Then
    scndMname = "Sep"
ElseIf frstMname = "Sep" Then
    scndMname = "Oct"
ElseIf frstMname = "Oct" Then
    scndMname = "Nov"
ElseIf frstMname = "Nov" Then
    scndMname = "Dec"
ElseIf frstMname = "Dec" Then
    scndMname = "End"
Else
    MsgBox "No Month Found"
End If

As you might have realised, this is, just, messy.

First off, if you ever find yourself using multiple ElseIfs, a Select ... Case statement is almost always a better idea.

So:

Select Case firstMonthName

    Case Is = "Jan"
        secondMonthName = "Feb"

    Case Is = "Feb"
        secondMonthName = "Mar"

    ...

    Case Else
        MsgBox "Could not identify """ & firstMonthName & """ as month"
        Exit Sub

End Select

In this case, I would handle it by converting your month to an index, then adding 1. Checking for valid month string is tricky, but this is how I'd handle it:

Dim ixMonth As Long, testVar as Variant

On Error Resume Next
testVar = CDate("01/" & firstMonthName & "/2000")
On Error Goto 0

If IsDate(testVar) then 
    ixMonth = Month(testVar)

    If ixMonth = 12 Then
        secondMonthName = "End"
    Else
        secondMonthName = MonthName(ixMonth + 1)
    End If
Else
    '/ Error handling
End If

It also has the advantage that you can use "Jan", "January" etc. So long as it's a valid month identifier.

---

' Removing all " " from text as NG report has " " and then text
ws2.Cells.Replace What:=" ", Replacement:=ClearContents, LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=Fals

Do you intend to change E.G. "Some Text" into "SomeText"? If you only want to get rid of leading/trailing spaces, how about the Trim() function?

---

    On Error Resume Next
    Set cell = zRng1(i, 1)
        'Find state in xls
        frstSrow = Application.WorksheetFunction.Match(cell, ws2.Range("B:B"), 0)
    Set cell = zRng1(i + 1, 1)
        'Find second state in xls
        scndSrow = Application.WorksheetFunction.Match(cell, ws2.Range("B:B"), 0)
    On Error GoTo 0

On Error Resume Next is not to be used lightly. It should be avoided wherever feasible, especially when you're inexperienced. If you *do* need to use it, it should be as tightly constrained as possible.

This is what a valid use generally looks like:

On Error Resume Next
    Statement that might throw an error
On Error Goto 0

Error Handling
Error Handling
Error Handling

Having more than one line with errors disabled is already a big warning sign. Having whole chunks of code running with errors disabled is actively Dangerous, because if errors *do* occur, then they're not going to be handled, and they're going to sit there silently corrupting your outputs.

Validate your variables. Check for edge cases. And if after all that you *still* need to disable errors for a particular operation, keep it constrained and immediately handle the error you're expecting to occur.

Answer 2

Let's talk about this a little bit.

If frstMname = "Jan" Then
    scndMname = "Feb"
ElseIf frstMname = "Feb" Then
    scndMname = "Mar"
ElseIf frstMname = "Mar" Then
    scndMname = "Apr"
ElseIf frstMname = "Apr" Then
    scndMname = "May"
ElseIf frstMname = "May" Then
    scndMname = "Jun"
ElseIf frstMname = "Jun" Then
    scndMname = "Jul"
ElseIf frstMname = "Jul" Then
    scndMname = "Aug"
ElseIf frstMname = "Aug" Then
    scndMname = "Sep"
ElseIf frstMname = "Sep" Then
    scndMname = "Oct"
ElseIf frstMname = "Oct" Then
    scndMname = "Nov"
ElseIf frstMname = "Nov" Then
    scndMname = "Dec"
ElseIf frstMname = "Dec" Then
    scndMname = "End"
Else
    MsgBox "No Month Found"
End If

So, first off, I am happy to see that you handled the unexpected case. The problem is you didn't handle it well. Can your code run properly if no month is found? I doubt it. You should probably display that message box with an error icon and abort by exiting the subroutine right there.

The other issue is the sheer repetitiveness of the code. Your abbreviations for months could be represented very well as a Dictionary.

Dim months As Scripting.Dictionary
months = New Scripting.Dictionary

months.Add "Jan", 1
months.Add "Feb", 2
' etc. 

Then you could set the second month something like so.

If Not months.Exists(firstMonthName) Then
    MsgBox "Blow Up!"
    Exit Sub
End If

secondMonthName = months.Keys(months(firstMonthName))

So, I know it's not terribly obvious, but this works because Keys returns a zero indexed array, but our month numbers start at 1. Perhaps it'd be a bit easier to read if we introduced a variable.

Dim secondMonthIndex = months(firstMonthName)
secondMonthName = months.Keys(secondMonthIndex)

Either way, this method allows us to remove the duplication and string literal by utilizing a lookup table.