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

• Mathieu Guindon: Why truncated? Give us all you've got! =)
• findwindow: Yea but now Zak will see I only applied 1% of his advice XD
• Raystafarian: 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.
• findwindow: 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: 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

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.

• findwindow: 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: Now, the part about not needing a second collection and reusing the original.... brilliant ^__^
• user109261: 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.
• findwindow: 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.
• user109261: I'm writing an edit now. What column are Cost Centers on in the Acuals worksheet?

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

• findwindow: 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: 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?
• user109261: Sorry about that I did get off topic. Editing now...
• findwindow: 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.
• user109261: 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.

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.

• findwindow: 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: It goes back to my idea of having item.costcenter.found but apparently that's not possible XD
• user109261: It's possible but costcenter would have to be its own class.
• user109261: 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: Range is not a nested function. It's a Class Object.