# Error handling for cells.find

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
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
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
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

• Why truncated? Give us all you've got! =) – Mathieu Guindon Jun 21 '16 at 19:48
• Yea but now Zak will see I only applied 1% of his advice XD – findwindow Jun 21 '16 at 19:53
• If you haven't implemented the changes, they will just be recommended again.. which is wasting both your time and our time. Make the changes you feel you need, explain why you didn't do what you didn't do and give us the entire thing. – Raystafarian Jun 22 '16 at 10:58
• I started to edit OP explaining changes I didn't make then canceled it. I am not a programmer and will likely never be one nor do I work with programmers. So my code is really just for me. I changed answer because it made sense to do so but kept actualsWS because that makes sense to me as is. I am on SO/CR because I am interested in programming concepts such as class, encapsulation, error handling, architecture. Stuff that directly pertains to the operation of the code. Readability for other/subsequent users doesn't apply to me. – findwindow Jun 22 '16 at 16:30
• None of my code is super long/complex so if my future me forgets/confused, it won't be too hard to figure out what past me did XD – findwindow Jun 22 '16 at 16:34

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


• 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.

• The month function is good. Clever even but what Mat had suffices. (And I like it because it taught me error handling.) The naming and the part about excel subtotals are good. The latter I can't do because this workbook contains a dozen sheets which all tie together. I would have to rearchitect everything. My boss would kill me. – findwindow Jun 22 '16 at 16:42
• Now, the part about not needing a second collection and reusing the original.... brilliant ^__^ – findwindow Jun 22 '16 at 16:43
• Thanks! I understand we all get stuck dealing with legacy. The majority of VB code that I see is needed because manages and end users are afraid of change. – user109261 Jun 22 '16 at 19:33
• Just realized that the found property would require another class? Because I would need to do item.costcenter.found right? Edit: or I guess it's easier to key the collection instead. – findwindow Jun 22 '16 at 20:34
• I'm writing an edit now. What column are Cost Centers on in the Acuals worksheet? – user109261 Jun 22 '16 at 21:20

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
End If

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
End If

End Sub

• I should just stick with SO. Don't understand the entire thing but my question was about error checking which you seem to have disregarded. The issue with dictionary is that you assume a cost center only happens once. The array covers all year but only one row? If so, pastevalues will just over write the last cost center data. – findwindow Jun 23 '16 at 15:34
• dataitems is a variant at beginning of function and you use method exists then at the end create the object?? Also, Len(msg) means false? – findwindow Jun 23 '16 at 15:35
• Sorry about that I did get off topic. Editing now... – user109261 Jun 23 '16 at 15:38
• Just post a new answer. This is a good reference for using classes and dictionary. Please demonstrate your idea of using a boolean property in the class per your first answer in your new answer. That's brilliant but I can't figure out how to implement it. – findwindow Jun 23 '16 at 15:41
• I missed something when I wrote that. The problem that you are going to have trying to implemented the Cost Center not found message, is that each Cost Center may have multiple items associated with it. This would cause multiple messages per Cost Center. I'll do a quick work around. – user109261 Jun 23 '16 at 15:49

Public Found As Boolean

    If Not locActual Is Nothing Then     'if found
........ some code ..........
Item.Found = True
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
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!!



On Error Resume Next
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
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.

• lol I missed something. What exactly is item? It's our class object with 4 properties. So what does item.found really mean? XD – findwindow Jun 23 '16 at 16:21
• It goes back to my idea of having item.costcenter.found but apparently that's not possible XD – findwindow Jun 23 '16 at 16:27
• It's possible but costcenter would have to be its own class. – user109261 Jun 23 '16 at 16:31
• The reason for add the found property is for future reference. It would be more useful if your were to do something with the data collection afterward. – user109261 Jun 23 '16 at 16:33
• Range is not a nested function. It's a Class Object. – user109261 Jun 23 '16 at 16:52