patternMinor
Transferring data for a given month from one sheet to another
Viewed 0 times
transferringsheetoneformonthanotherfromdatagiven
Problem
I have dollar amounts sorted by month that I want to transfer from sheet
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
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 StringSomething 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 FunctionSo, 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 PropertyNow 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
LoopBecomes 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
LoopAnd 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 FunctionYou could also define an
Enum to get rid of the magic values there:Private Enum ColumnPosition
DescriptionColumn = 9
CostCenterColumn = 11
AmountColumn = 13
End EnumAnd 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 FunctionThe 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
LoopAnd 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
'...
NextAgain, 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 StringPublic 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 FunctionOption 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 PropertyDo 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
LoopDim 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
LoopContext
StackExchange Code Review Q#132543, answer score: 6
Revisions (0)
No revisions yet.