Excel VBA: For Each loop set up

Question

Edit: Added sample of raw data below

I run a claim report every month and copy the data into a tab. All of the data is organized into columns and I've been using a spreadsheet full of SumProduct's and CountIf's to count and organize the data based on different sets of criteria but it just takes too long to process so I'm trying to write a VBA sub to accomplish this more efficiently. One of the columns of data is "Adjuster Home Office". This column is basically a list of offices where each claim originated from. I used AdvancedFilter to extract all of the unique values in this column and copy them to a separate tab in column A. Then, in column C, below each location, I have a list of the claim types or "line items" handled at each office. I have no problem getting this part set up. In column D, I need to be able to display the count of each line item at that designated location. This is where all the Countif's and SumProduct's came into play in my old template I had been using. This is where I hit a snag. I'm trying to use For Each loops to count each line item in column B below the first location, then move to the next location in column A and repeat. Below is the code I've tried:

Private Sub CommandButton23_Click()

Dim linerngs As Range
Dim lineitem As Range
Dim lastlinerow As Long
Dim wsf
Dim TabLastRow
Dim claimstab As String
Dim officesrange As Range
Dim office As Range

claimstab = Sheet2.Range("F2") & " Claims"

TabLastRow = Sheets(claimstab).Cells(Sheets(claimstab).Rows.Count, "A").End(xlUp).Row

Set wsf = Application.WorksheetFunction

officeslastrow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
lastlinerow = Sheet2.Range("C" & Rows.Count).End(xlUp).Row

Set officerng = Range("A6:A" & officeslastrow).SpecialCells(xlCellTypeConstants, 23)
Set linerngs = Range("C7:C" & lastlinerow).SpecialCells(xlCellTypeConstants, 23)

For Each office In officerng
    For Each lineitem In linerngs
        If InStr(1, lineitem.Value, "IN") > 0 And InStr(1, lineitem.Value, "AOS") = 0 Then
            lineitem.Offset(0, 3) = Application.WorksheetFunction.SumProduct(wsf.CountIfs(Sheets(claimstab).Range("B2:B" & TabLastRow), office))
        End If
    Next lineitem
Next office


End Sub

I know this is incorrect because these loops are going to loop through everything in column B rather than just the line items below each location. So what I end up with is the count of the last location displayed for every line item in the entire column. below is an example of what I need it to look like. Right now, all im concerned with is setting up the loop to run correctly.

example of what I currently get [

example of what I'm trying to get [

You can see from the first example that I'm getting the value "3" for everything. I included a pivot of the locations and their values. you can see that the last location in the pivot, South Portland, has a count of 3.

Any help would be GREATLY appreciated.

example of raw data [

Objective [

[ the list of line items is completed created by a userform asking for user imputs

Answer 1

This may not be the answer you are looking for, but I think this is how I would approach your project. It would be helpful to see the raw data that you get in your report and paste into a spreadsheet.

First two assumptions (and you know what they say about assumptions)

1. The data is being pulled from a database and is returned as rows which may not be in order. For example:

 ATLANTA, GA     IN-AK, HI  3  IN-CA  2  ...  IncidentOnly  4
 BOCA RATON, FL  IN-AK, HI  3  IN-CA  6  ...  IncidentOnly  5 
 ATLANTA, GA     IN-AK, HI  1  IN-CA  0  ...  IncidentOnly  2 
 ...
 AURORA, IL      IN-AK, HI  7  IN-CA  3  ...  IncidentOnly  4 

2. You want all of the insurance products summed for each office and then displayed in a prettier report format.

If these assumptions are true (or close to true), you could create a HomeOffice class that had a property for each type of insurance, then simply loop through the rows of data in the raw report and add each HomeOffice object to a collection so you get a unique list of offices.

An example from a similar sounding project I did:

Raw Data:
Mary    2   6
Sally   4   9
Mary    4   1
Sally   3   8
Joe     1   4
Bob     3   7
Mary    6   9
Sally   8   4
Bob     4   8
Joe     2   6
Joe     4   5

Formatted Data:
Mary       12      16
Sally      15      21
Bob         7      15
Joe         7      15

To do this, add a Class module (Insert -> Class Module) and change its name to HomeOffice. Insert this code into the class (some bits skipped so its not so long. Fill in where needed adding a property for each insurance product.)

Option Explicit

Private pOffice As String
Private pINAKI As Double
Private pINCA As Double
'... class properties left out for brevity
Private pIncidentOnly As Double


''''''''''''''''''''''
' Office property
''''''''''''''''''''''
Public Property Get Office() As String
    Office = pOffice
End Property
Public Property Let Office(Value As String)
    pOffice = Value
End Property

''''''''''''''''''''''
' INAKI property
''''''''''''''''''''''
Public Property Get INAKI() As Double
    INAKI = pINAKI
End Property
Public Property Let INAKI(Value As Double)
    pINAKI = Value
End Property

''''''''''''''''''''''
' INCA property
''''''''''''''''''''''
Public Property Get INCA() As Double
    INCA = pINCA
End Property
Public Property Let INCA(Value As Double)
    pINCA = Value
End Property

''''''''''''''''''''''
' Add other propertied for the different product types
''''''''''''''''''''''
' Follow the same format as the other properties

''''''''''''''''''''''
' IncidentOnly property
''''''''''''''''''''''
Public Property Get IncidentOnly() As Double
    IncidentOnly = pIncidentOnly
End Property
Public Property Let IncidentOnly(Value As Double)
    pIncidentOnly = Value
End Property

Now in your CommandButton23_Click sub add this code (again shortened for brevity, but hopefully you get the picture.):

Sub test()
    Dim col As Collection
    Dim r As Integer
    Dim c As Integer
    Dim HO As New HomeOffice

    'Collections can only have one Item, Key pair. 
    'We'll use the office location as the key to get a 
    'unique list of offices
    Set col = New Collection

    'Read in the raw data
    With Sheet1
        For r = 1 To .UsedRange.Rows.Count
            'Check if the location has an existing HomeOffice object 
            If InCol(col, .Cells(r, 1)) Then
                'It does so get the existing object and total the values
                Set HO = col.Item(.Cells(r, 1))
                HO.Office = .Cells(r, 1)
                HO.INAKI = HO.INAKI + .Cells(r, 2)
                HO.INCA = HO.INCA + .Cells(r, 3)
                ' more properties
                HO.IncidentOnly = HO.IncidentOnly + .Cells(r, 10)
                'We have to remove the existing object and add it again
                'to reflect the updated totals
                col.Remove (.Cells(r, 1))
            Else
                'The location hasn't been added yet so create and add it
                HO.Office = .Cells(r, 1)
                HO.INAKI = .Cells(r, 2)
                HO.INCA = .Cells(r, 3)
                ' More properties
                HO.IncidentOnly = .Cells(r, 10)
            End If
            col.Add HO, .Cells(r, 1)
            'Important to clear our object or our totals are wrong! :)
            Set HO = Nothing
        Next r
    End With

    'Now we simply loop through our collection of offices and
    'print out the totals.
    r = 6 'The first office starts on row 6 in your picture
    With Sheet2
        For Each HO In col
            .Cells(r, "A").Value = HO.Office
            .Cells(r + 1, "C").Value = "IN - AK, HI"
            .Cells(r + 1, "F").Value = HO.INAKI
            .Cells(r + 2, "C").Value = "IN - CA"
            .Cells(r + 2, "F").Value = HO.INCA
            'Continuing on for all 10 types
            .Cells(r + 10, "C").Value = "Incident Only"
            .Cells(r + 10, "F").Value = HO.IncidentOnly
            Set HO = Nothing
            r = r + 13 'So the next office starts 13 rows later...Row 19 in your pic
        Next
    End With
End Sub

Function InCol(col As Collection, key As Variant) As Boolean
    'Returns TRUE if the object is in the collection or FALSE if it is not
    Dim obj As New HomeOffice

    On Error GoTo err
    InCol = True
    'If the key doesn't exist, it throws an error and set the function to false
    Set obj = col(key)
    Set obj = Nothing
    Exit Function

err:
        InCol = False
End Function

This is a drastically different approach, and involves some tougher concepts. Like I said, it may not work depending on how the raw data is formatted, but maybe it can give you a different way to approach your problem.