HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Transferring data for a given month from one sheet to another

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
transferringsheetoneformonthanotherfromdatagiven

Problem

I have dollar amounts sorted by month that I want to transfer from sheet entry to sheet actuals. I only want to do it for a specified month prompted from user. Each dollar amount has a corresponding cost center/ID and description in separate columns. I want to copy the amounts and description from entry to the row in actuals matching the same ID.

Sometimes, multiple amounts share the same ID so I need to place them one below the other.

```
Sub month()

Dim actualsWS As Worksheet
Dim dataWS As Worksheet
Dim answer As String
Dim month As String
Dim loc As Range
Dim start As Integer
Dim rowCol As Variant
Dim dropRow As Integer
Dim dropCol As Integer
Dim locActual As Range

'store worksheets into variables
Set actualsWS = ThisWorkbook.Worksheets("Actuals by Month")
Set dataWS = ThisWorkbook.Worksheets("FAS Data Entry")

MsgBox ("If macro dies, it's likely a missing cost center.") 'warning for user

answer = InputBox(prompt:="What month?") 'prompt user for current month

'set month from user input
Select Case answer

Case 1
month = "January"
'dropCol = 9
Case 2
month = "February"
'dropCol = 10
Case 3
month = "March"
'dropCol = 11
Case 4
month = "April"
'dropCol = 12
Case 5
month = "May"
'dropCol = 13
Case 6
month = "June"
'dropCol = 14
Case 7
month = "July"
'dropCol = 15
Case 8
month = "August"
'dropCol = 16
Case 9
month = "September"
'dropCol = 17
Case 10
month = "October"
'dropCol = 18
Case 11
month = "November"
'dropCol = 19
Case 12
month = "December"
'dropCol = 20
Case Else
MsgBox ("Bad month. Exiting...")
Exit Sub

End Select

Dim ccArray(99) 'cost center
Dim amountArray(99) As Currency 'amount
Dim descriptArray(99) 'description
Dim ccArrayLength As Integer

With dataWS

'locate starting range for current month
Set loc = .Cells.Find(month)

'check previous row for carried over month (revisin

Solution

Sub month()

Dim month As String


Something isn't right, one of these two has the wrong name. Procedure names should start with a verb, they do something. If you can name that something, then you can name the procedure. If you can't name that something, then your procedure is doing too many things and needs to be broken down into something that can be named.

So we're getting the month name for some user input - if that's always going to be in English, then there's no need to hard-code that in a Select Case block.

Public Function ToMonthName(ByVal value As Integer) As String
    On Error GoTo CleanFail 'remove if runtime error 5 should bubble up to caller instead

    Dim result As String
    result = MonthName(value)

CleanExit:
    ToMonthName = result
    Exit Function
CleanFail:
    result = vbNullString
    Resume CleanExit
End Function


So, now we have the month name (or an empty string), that month procedure can actually start focusing on its task.

It's confusing that every code paths execute the died: label. There's no error handling - seeing that line label I was expecting to see On Error GoTo died somewhere.

So two things are happening here. First we're iterating dataWS and populating three arrays in parallel - there's a design smell right here: you have 3 data structures that are "in sync", when there should really be only one.

Make a small class module, and expose the 3 properties you're interested in:

Option Explicit
Private Type TModel
    CostCenter As String
    Description As String
    Amount As Single
End Type

Private this As TModel

Public Property Get CostCenter() As String
    CostCenter = this.CostCenter
End Property

Public Property Let CostCenter(ByVal value As String)
    this.CostCenter = value
End Property

Public Property Get Description() As String
    Description = this.Description
End Property

Public Property Let Description(ByVal value as String)
    this.Description = value
End Property

Public Property Get Amount() As Single
    Amount = this.Amount
End Property

Public Property Let Amount(ByVal value As Single)
    this.Amount = value
End Property


Now you can store instances of this class, which encapsulates the data you're interested in. This:

Do While .Cells(start + i, 1) <> "" 'loop through column A while there is a month present (not blank)

    ccArray(i) = .Cells(start + i, 11).Value 'store cost center
    amountArray(i) = .Cells(start + i, 13).Value 'store amount
    descriptArray(i) = .Cells(start + i, 9).Value 'store description

    i = i + 1

Loop


Becomes this:

Dim data As Collection
Set data = New Collection

Dim item As DataModel 'assuming class name was "DataModel"

Do While .Cells(start + i, 1) <> vbNullString 'loop through column A while there is a month present (not blank)

    Set item = New DataModel
    item.CostCenter = .Cells(start + i, 11).Value
    item.Amount = .Cells(start + i, 13).Value
    item.Description = .Cells(start + i, 9).Value

    data.Add item        
    i = i + 1

Loop


And now if the body of that loop was extracted into its own function...

Private Function ReadModel(ByVal source As Range) As DataModel
    Dim result As New DataModel
    result.CostCenter = source.Cells(1, 11).Value
    result.Amount = source.Cells(1, 13).Value
    result.Description = source.Cells(1, 9).Value
    Set ReadModel = result
End Function


You could also define an Enum to get rid of the magic values there:

Private Enum ColumnPosition
    DescriptionColumn = 9
    CostCenterColumn = 11
    AmountColumn = 13
End Enum


And then use them to enhance readability here:

Private Function ReadModel(ByVal source As Range) As DataModel
    Dim result As New DataModel
    result.CostCenter = source.Cells(1, CostCenterColumn).Value
    result.Amount = source.Cells(1, AmountColumn).Value
    result.Description = source.Cells(1, DescriptionColumn).Value
    Set ReadModel = result
End Function


The calling code will now look like this:

Dim data As Collection
Set data = New Collection

Do While .Cells(start + i, 1) <> vbNullString 'loop through column A while there is a month present (not blank)

    data.Add ReadModel(.Range("A" & start + i).EntireRow)
    i = i + 1

Loop


And now if you ever need to read more values, that code doesn't even need to change - you can simply modify the DataModel accordingly, and the function that reads a row's values into an instance. And this loop and collection should go into its own function, too.

The number of items in the collection would be simply data.Count.

Next the loop that consumes this data, could be a For Each loop:

Dim item As DataModel
For Each item In data
    '...
Next


Again, this should be in its own procedure. On Error Resume Next shouldn't need to be there. What errors are being thrown under the carpet? They should be handled.

Code Snippets

Sub month()

Dim month As String
Public Function ToMonthName(ByVal value As Integer) As String
    On Error GoTo CleanFail 'remove if runtime error 5 should bubble up to caller instead

    Dim result As String
    result = MonthName(value)

CleanExit:
    ToMonthName = result
    Exit Function
CleanFail:
    result = vbNullString
    Resume CleanExit
End Function
Option Explicit
Private Type TModel
    CostCenter As String
    Description As String
    Amount As Single
End Type

Private this As TModel

Public Property Get CostCenter() As String
    CostCenter = this.CostCenter
End Property

Public Property Let CostCenter(ByVal value As String)
    this.CostCenter = value
End Property

Public Property Get Description() As String
    Description = this.Description
End Property

Public Property Let Description(ByVal value as String)
    this.Description = value
End Property

Public Property Get Amount() As Single
    Amount = this.Amount
End Property

Public Property Let Amount(ByVal value As Single)
    this.Amount = value
End Property
Do While .Cells(start + i, 1) <> "" 'loop through column A while there is a month present (not blank)

    ccArray(i) = .Cells(start + i, 11).Value 'store cost center
    amountArray(i) = .Cells(start + i, 13).Value 'store amount
    descriptArray(i) = .Cells(start + i, 9).Value 'store description

    i = i + 1

Loop
Dim data As Collection
Set data = New Collection

Dim item As DataModel 'assuming class name was "DataModel"

Do While .Cells(start + i, 1) <> vbNullString 'loop through column A while there is a month present (not blank)

    Set item = New DataModel
    item.CostCenter = .Cells(start + i, 11).Value
    item.Amount = .Cells(start + i, 13).Value
    item.Description = .Cells(start + i, 9).Value

    data.Add item        
    i = i + 1

Loop

Context

StackExchange Code Review Q#132543, answer score: 6

Revisions (0)

No revisions yet.