CODEWITHSUNDEEP
stringvbalistloops
Dennis Christiansen
Dennis Christiansen

Reputation: 165

VBA module to check if list, contains two names from dynamic list

I'm trying to automate an accounting process. Every month I get a list of expenses, and I have to calculate teh total amount for each person. A cell will contain some text specifing what it is and which employee brought this item and the one next to will specify the amount.

I created a script that will look through the list and give me a total expense for each employee. The possible names are specified in a range in the document.

The problem is that a few of these cells will sometimes contain two names and the amount is then added to both employees total amount.

Problem: Is it possible to create an If statement that will look through my list of names and "do something" if the cell contains TWO names from my list.

EDIT: This is the loop I already created 

Sub AfstemLoop()
    Worksheets("Main").Activate

    Dim NamesAmount As Integer
    Dim NameString As String
    Dim TotalAmount As Double
    Dim TableStart As Integer

    'Count Amount of names
    NamesTotal = 0
    For i = 1 To 100
        If Worksheets("Main").Cells(i + 1, 7) <> "" Then
            NamesTotal = NamesTotal + 1
        End If
    Next

    'Count entries
    EntriesTotal = 0
    For i = 1 To 1000
        If Worksheets("Main").Cells(2 + i, 1) <> "" Then
            EntriesTotal = EntriesTotal + 1
        End If
    Next

    'Define table start
    TableStart = EntriesTotal + 4

    'Calculate total amount
    For i = 1 To NamesTotal
        TotalAmount = 0
        NameString = Worksheets("Main").Cells(i + 1, 7)
        For j = 1 To EntriesTotal
            CellText = Worksheets("Main").Cells(j + 2, 3)
            If InStr(1, CellText, NameString) Then
                Amount = Worksheets("Main").Cells(j + 2, 4)
                TotalAmount = TotalAmount + Amount
                    'Test to see if cell has been used (in case of spelling mistakes)
                    Worksheets("Main").Cells(j + 2, 4).Interior.Color = 5296274
            End If
        Next

        Worksheets("Main").Cells(TableStart + i, 3) = NameString
        Worksheets("Main").Cells(TableStart + i, 4) = TotalAmount
        Sum = TotalAmount + Sum
   Next

   Worksheets("Main").Cells(TableStart + NamesTotal + 1, 3) = "Total"
   Worksheets("Main").Cells(TableStart + NamesTotal + 1, 4) = Sum

End Sub

Upvotes: 0

Views: 107

Answers (1)

Maciej Lipinski
Maciej Lipinski

Reputation: 185

You check whether a name occurs and do stuff every time it happens:

For j = 1 To EntriesTotal
    CellText = Worksheets("Main").Cells(j + 2, 3)
    If InStr(1, CellText, NameString) Then
        Amount = Worksheets("Main").Cells(j + 2, 4)
        TotalAmount = TotalAmount + Amount
            'Test to see if cell has been used (in case of spelling mistakes)
            Worksheets("Main").Cells(j + 2, 4).Interior.Color = 5296274
    End If
Next

You want to change that so the code performs different tasks depending on the number of names in the cell. I suggest you introduce a name occurrence counter:

Dim namesInCellCount as long
namesInCellCount = 0

For j = 1 To EntriesTotal
    CellText = Worksheets("Main").Cells(j + 2, 3)
    If InStr(1, CellText, NameString) Then
        namesInCellCount = namesInCellCount + 1
    End If
Next

If namesInCellCount = 1 then
    'do your thing
ElseIf namesInCellCount > 1 then
    'do your other thing
End If

Just remember to reset the counter after you're done working with a cell (or before you start checking a new one). The Dim statement belongs at the top section of your code, beside other such statements.

Upvotes: 1

Related Questions