Revised ~~and truncated~~ version of my [last question](https://codereview.stackexchange.com/questions/132543/transferring-data-for-a-given-month-from-one-sheet-to-another#132543). 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

```