Error handling for cells.find

Question

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 1

This function will either return "" or the name of month.

Function getMonth() As String
    Dim msg As String
    Dim m As String
    Dim i As Integer
    msg = "What Month?"
    For i = 1 To 12
        msg = msg & vbCrLf & i & " - " & MonthName(i)
    Next

    i = Application.InputBox(msg, "Choose a Month", month(Date), , , , , 1)

    If i > 0 Then getMonth = MonthName(i)
End Function

ReadModel(.Range("A" & start + i).EntireRow)

ReadModel is miss leading.

• getModel()
• getNewModel()
• createModel()
• getModelFromRow()

Replace .Range("A" & start + i).EntireRow with .Rows(i)

The failed collection is not necessary.

Dim failed As Collection

If you are planning on using the data collection elsewhere, add a Found property to your DataModel.

Private Type TModel
    CostCenter As String
    Description As String
    Amount As Single
    Found as Boolean
End Type

If you are not going to reuse the data collection, just remove the items form data as you find them.

item.Remove data Is this your Output:

Actuals by Month

Cost Center | Item Amount | Item Description Janitorial

.....Possibly 99 blank rows later Front Office
$45.00 12 Reams Standard Letter Size $10.34 24 Red Pens $23.56 1 Case Sticky Pads .....Possibly 96 blank rows later Sales Dept $45.00 12 Reams Standard Letter Size $123.99 10 Cases Type 2 Invoices .....Possibly 97 blank rows later Facilities

.....Possibly 99 blank rows later

Couldn't this be achieved by filtering your FAS Data Entry by month and applying standard Excel grouping and subtotaling techniques?

I would recommend clearing the Cost Centers off of the [Actuals by Month] and writing them in from row 1 as you iterate through the data collection. If you need a complete list of Cost Centers, simply add them to the data collection in your initial loop.

Answer 2

I don't like updating the Call Centers month by month and think that all the data should be cleared from the Actual's worksheet and then updated. I would then add each Cost Center and their items to the Actual's worksheet.

Because I don't know what other information is stored on the Actual's worksheet, here is how I think that it should be done.

Like Mat's Mug I believe that the uses of Enumerations makes your code easier to read, debug and modify.

Column's Enumeration

Public Enum ColumnPosition
    MonthColumn = 8 ' FAS Data Entry Month Column
    DescriptionColumn = 9
    CostCenterColumn = 11
    AmountColumn = 13
    FirstMonth = 8 ' Actuals by Month
End Enum

DataItem Class

Option Explicit

Private arrData

Private Sub Class_Initialize()
    ReDim arrData(12, 0)
End Sub

Public Sub AddItem(sMonthName As String, Description As String, Amount As Single)
    Dim i As Integer, m As Integer

    m = getMonthIndex(sMonthName)
    Debug.Print sMonthName, m

    i = getEmtpyRow(m)
    arrData(m, i) = Amount

    i = getEmtpyRow(m)
    arrData(m, i) = Description

End Sub

Private Function getMonthIndex(sMonthName As String) As Integer
    getMonthIndex = month("01-" & sMonthName & "-1900") - 1
End Function

Private Function getEmtpyRow(m As Integer) As Long
    Dim i As Integer, iRow As Integer
    iRow = -1
    For i = 0 To getSize
        If IsEmpty(arrData(m, i)) Then
            iRow = i
        End If
    Next

    If iRow = -1 Then
        iRow = getSize + 1
        ReDim Preserve arrData(12, iRow)
    End If

    getEmtpyRow = iRow
End Function

Public Function getSize()
    getSize = UBound(arrData, 2)
End Function

Public Sub PasteValues(Destination As Range)
    Destination.Resize(getSize + 1, 12) = WorksheetFunction.Transpose(arrData)
End Sub

Collect the Call Centers using a Scripting Dictionary

Iterates over the FAS Data Entry collecting dataitems in a dictionary of Cost Centers. As data is added to a dataitem it is stored in a 12 dimensional array corresponding to the month of the data.

Function getCallCenterItems()
    Dim sMonthName As String, CostCenter As String, Description As String, Amount As Single
    Dim i As Integer, lastRow As Long
    Dim DataItems
    Dim item As DataItem

    With ThisWorkbook.Worksheets("FAS Data Entry")
        lastRow = .Cells(rowS.Count, MonthColumn).End(xlUp).Row
        For i = 2 To lastRow
            sMonthName = Cells(i, MonthColumn)
            CostCenter = Cells(i, CostCenterColumn)
            Amount = Cells(i, AmountColumn)
            Description = Cells(i, DescriptionColumn)

            If DataItems.Exists(CostCenter) Then
                Set item = DataItems(CostCenter)
            Else
                Set item = New DataItem
                DataItems.Add CostCenter, item
            End If

            item.AddItem sMonthName, Description, Amount
        Next i
    End With
    Set DataItems = CreateObject("Scripting.Dictionary")
End Function

Update the Call Centers

Here we find each Cost Centers in the dictionary and use item.PasteValues (.Cells(locActual.Row, FirstMonth)) to transpose the data collected for all the year. In this way, there is no need to ask for user input.

Sub UpdateCallCenters()
    Dim DataItems As Dictionary
    Dim item As DataItem
    Dim CostCenter As Variant, msg As String
    Dim locActual As Range
    Set DataItems = getCallCenterItems

    With ThisWorkbook.Worksheets("Actuals by Month")
        .Range(.Cells(2, FirstMonth), .Cells(2, FirstMonth + 12)).ClearContents

        For Each CostCenter In DataItems.Keys
            Set locActual = .Cells.Find(CostCenter)
            Set item = DataItems(CostCenter)
            item.PasteValues (.Cells(locActual.Row, FirstMonth))
            DataItems.Remove CostCenter
        Next
    End With

    For Each CostCenter In DataItems.Keys
       msg = msg & vbCrLf & CostCenter
    Next

    If Len(msg) Then
        MsgBox msg, vbInformation, "Cost Centers Not Found"
    End If

End Sub

Answer 3

Add this to your DataModel Class

Public Found As Boolean

    If Not locActual Is Nothing Then     'if found
            ........ some code ..........
        Item.Found = True
    Else     'if not found
        Item.Found = False
    End If

EDITED: After we finish adding the data to the Actual's worksheet can pass the data collection to another sub routine.

MissingCallCenterMessage data

    

Sub MissingCallCenterMessage( data as Collection)
    Dim message As String
    Dim item as Variant
    For Each item In failed 'loop through collection to store all failed cost centers into one variable
        If Not item.found then 
            message = message & item.CostCenter & vbNewLine
        End If
    Next

    If Len(message) Then
        MsgBox message, vbInformation, "Cost Centers Not Found"
    End If
End Sub

You would be better off keeping your current strategy than to implement the this.

What you need to do is add the Cost Centers to the failed collection as a key. Keys are unique. The collection will throw an error when you try to add the same key twice. But will can handle that!!

Else 'if not found

    On Error Resume Next
    failed.Add Null, Item.CostCenter
    On Error GoTo 0

End If

This will prevent any duplicate Call Centers from being added to the failed collection.

    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

    If Len(message) Then
        MsgBox message, vbInformation, "Cost Centers Not Found"
    End If

Boolean logic considers 0 as False and anything <> 0 as true
Len counts the number of characters in a string.
Know that we can do this:

If Len(message) Then

Basically it's short hand for saying if there is a message do something.