Revised and truncated version of my last question. I updated how I handle the error if a cost center is not found. I originally asked expecting improvements on the matching system so thoughts on that will also be appreciated. Finally, interested in improvements to the looping part to determine first blank cell to drop data (the line starting with For y = 0 To 99
).
Of course, surprise me with things I don't even think about ^_^;
Sub transfer()
Dim actualsWS As Worksheet
Dim fromWS As Worksheet
Dim inputMonth As Integer
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 fromWS = ThisWorkbook.Worksheets("FAS Data Entry")
MsgBox ("If macro dies, it's likely a missing cost center.") 'warning for user
inputMonth = InputBox(prompt:="What month?") 'prompt user for current month
month = ToMonthName(inputMonth) 'call function to turn number into string
If month = vbNullString Then 'if bad month, quit sub
MsgBox ("bad month")
Exit Sub
End If
With fromWS 'data entry tab
Set loc = .Cells.Find(month) 'locate starting range for current month
'check previous row for carried over month (revising asset) Will break if 2 or more
If loc.Offset(-1, 0) = "" Then 'if previous row is blank
start = loc.row 'starting row is same row as found location above
Else
start = loc.row - 1 'else it's 1 row above
End If
i = 0
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)
'passes entire row to function then add it to collection
data.Add ReadModel(.Range("A" & start + i).EntireRow)
i = i + 1
Loop
End With
With actualsWS 'actuals tab
.Columns("V:W").ClearContents 'clear previous data
'hide unnecessary months
If month = "January" Or month = "February" Or month = "March" Or month = "April" Then
.Columns("M:Q").EntireColumn.Hidden = True
End If
Dim item As DataModel
Dim failed As Collection
Set failed = New Collection
'drop data into respective cells onto "actuals by month" tab
For Each item In data 'each collection item is a class object
Set locActual = .Cells.Find(item.CostCenter) 'find cost center location
If Not locActual Is Nothing Then 'if found
dropRow = .Range(locActual.Address).row 'store row of cost center
'for loop to find first empty cell to drop into
For y = 0 To 99 'no cost center should have over 99 rows
If .Cells(dropRow + y, 22).value = "" Then 'column v blank
.Cells(dropRow + y, 22).value = item.Amount 'drop amount
.Cells(dropRow + y, 22).Offset(0, 1).value = item.Description 'drop description on row below
Exit For
End If
Next
Else 'if not found
failed.Add item.CostCenter 'add it to failed collection
End If
Next
actualsWS.Cells(8, 22).Select 'bring cursor to top
Dim message As String
For Each e In failed 'loop through collection to store all failed cost centers into one variable
message = message & e & vbNewLine
Next
MsgBox message, , "cost centers not found" 'display all unfound cost centers
End With
Public Function ToMonthName(ByVal value As Integer) As String
'takes number entered by user and converts it to string
On Error GoTo CleanFail
Dim result As String
result = MonthName(value)
CleanExit:
ToMonthName = result
Exit Function
CleanFail:
result = vbNullString
Resume CleanExit
End Function
Private Function ReadModel(ByVal source As Range) As DataModel 'returns our class
'row of data from data entry tab gets passed in
Dim result As New DataModel 'create an object of our class
'let each class attribute pertain to the corresponding column from row
result.CostCenter = source.Cells(1, 11).value
result.Amount = source.Cells(1, 13).value
result.Description = source.Cells(1, 9).value
Set ReadModel = result 'set function to equal our class object
End Function
Class Module
Option Explicit
'class to contain cost center, description and amount
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
answer
because it made sense to do so but keptactualsWS
because that makes sense to me as is. I am on SO/CR because I am interested in programming concepts such asclass
, encapsulation, error handling, architecture. Stuff that directly pertains to the operation of the code. Readability for other/subsequent users doesn't apply to me. \$\endgroup\$