Excel Macro Tutorial 5 – Delete cancelled tests, flag credited tests

Excel Macro Tutorial 5 – Delete cancelled tests, flag credited tests

When a test is cancelled in the system it appears as a charge and then a credit with the same date and time.

The billing team does not want to see these, as they have to charge for a test and them immediately credit a test, and it’s a hassle.  So we clean them up before submitting.
Often a test gets ordered, cancelled, and then re-ordered, so it is important to make sure the code doesn’t delete the re-ordered test:

(In this case they ordered the test then realized it was already ordered so they cancelled the new order).

There are also simple credited tests, for whatever reason we cannot charge for them.  The billing team wants’ these tests to be highlighted and the word CREDIT typed in red in the last column beside it.

Also on these credited tests the quantity is a positive 1.  For whatever reason, the billing team wants this changed to a negative 1.

This will be the most complicated macro so far, and since we may be fiddling with multiple rows at a time, we cannot afford to use a janky while loop that changes it’s index on the fly like our previous macros.  Instead we will make a list of the rows that need to be deleted/marked, and double check them before taking action.

First thing I will do is add a UDT (User-defined-type) to the module. This will make the code much easier to understand and work with because we will be doing a lot of scanning and checking.

How to add a UDT to an Excel macro:

Private Type DELETEDTESTS
     strPatientName As String
     dtDateTime As Date
     strTestName As String
     intRow As Integer
End Type

Dim TestsToDelete() As DELETEDTESTS

Dim TestsToFlag() As DELETEDTESTS

You have to put UDT’s in a module, at the top of the module:

bill report udt place

I named the function HandleCredits. It uses 2 other functions called “SeekEvilTwin” and “IsInTestsToBeDeletedAlready”. You have to read the comments in the code to understand why these are so interestingly named.

Advanced Excel macro example with arrays, UDT’s, and functions:

Sub HandleCredits()
    'This macro will seek credits and take the appropriate action to handle them.
    'Cancelled tests will cancel each other out and be deleted.
    'Single credited tests will be highlighted and have quantity changed to a negative.

    'For this macro we could use a nested loop, but for clarity we will put the second
    'loop inside a separate function.
    'To record which row, patient, and time need to be deleted we will use an array and
    'a UDT or user-defined-type.  A separate array will handle simple credits.
    'The UDT is defined at the top of the macro module, along with the UDT arrays:
    'TestsToDelete() and TestsToFlag()

    'Loop through and analyze entire report
    intFinalRow = Range("A65536").End(xlUp).Row
    Dim intX As Integer 'Index to keep track in loop.
    ReDim TestsToDelete(0 To 0) 'This prepares the array and makes one blank spot ready.
    ReDim TestsToFlag(0 To 0)

    'This is a For Next loop and will repeat a fixed number of times unless 'Exit For' is read.
    For intX = 2 To intFinalRow 'For each row in the report...
        'We only care about credits so if the charge is positive we skip it.
        If Cells(intX, 5).Value < 0 Then 'If negative value then check.
            'Ok now we need to figure out if it's a credit or a cancel.  How?
            'Cancelled tests have an 'Evil Twin', a test with same Patient Name, Test, and DATE/TIME, but a positive charge. (why is positive evil? Because we can't overcharge!)
            'Credited tests may have a test with only the same Name and Test, but the DATE/TIME will be different.  More like an 'Evil Cousin". We don't care about them.
            'I will make a function to search for an evil twin, if none is found, the test will be added to the TestsToFlag array.

            Dim EvilTwinTest As DELETEDTESTS 'Stores evil twin info if found.
            Dim CreditedTest As DELETEDTESTS 'We can use the UDT to store test info, and pass it to our evil twin seeking function.
            With CreditedTest
                .strPatientName = Cells(intX, 1).Value
                .strTestName = Cells(intX, 3).Value
                .dtDateTime = Cells(intX, 8).Value
                .intRow = intX
            End With

            EvilTwinTest = SeekEvilTwin(CreditedTest) 'Seek it's twin!

            If EvilTwinTest.intRow > 0 Then 'This is a cancel
                'A test with same Patient name, date/time, but positive charge was found. This is a cancelled test.
                'Now we add this test and it's twin to the TestsToDelete array, to be deleted later.
                If UBound(TestsToDelete) = 0 Then 'Initially we set it to 0, so our blank spot is ready.
                    TestsToDelete(0) = CreditedTest

                    ReDim Preserve TestsToDelete(0 To 1)   'Have to make a spot for it's evil twin while preserving first info
                    TestsToDelete(1) = EvilTwinTest

                Else 'Increase array size and populate accordingly.
                    ReDim Preserve TestsToDelete(LBound(TestsToDelete) To UBound(TestsToDelete) + 1)
                    TestsToDelete(UBound(TestsToDelete)) = CreditedTest

                    ReDim Preserve TestsToDelete(LBound(TestsToDelete) To UBound(TestsToDelete) + 1)
                    TestsToDelete(UBound(TestsToDelete)) = EvilTwinTest
                End If 'End check for beginning of array.

            Else 'nothing indicates not found, so this is a credit.
                'Add test to TestsToFlag array
                If TestsToFlag(UBound(TestsToFlag)).strPatientName = "" Then 'Initially we set it to 0, so our blank spot is ready.
                    TestsToFlag(0) = CreditedTest

                Else 'Increase array size and populate accordingly.
                    ReDim Preserve TestsToFlag(LBound(TestsToFlag) To UBound(TestsToFlag) + 1)
                    TestsToFlag(UBound(TestsToFlag)) = CreditedTest
                End If 'End check for beginning of array.
            End If 'End check for evil twin (cancelled test)

        Else 'Else skip to next.
        End If 'End check neg val if.
    Next intX 'On to the next record

    'The loop has scanned the sheet and given us two arrays TestsToDelete and TestsToFlag.
    'Handling TestsToDelete may alter the row numbers of the data on the sheet, so we will start with TestsToFlag
    Dim intZ As Integer
    For intZ = LBound(TestsToFlag) To UBound(TestsToFlag)
        With TestsToFlag(intZ)
            'Remember, there will be at least one slot in TestsToFlag even if none matched, so we check for that:
            If .intRow > 0 And .strPatientName <> "" Then 'Something is there.
                'Add the credit flag and highlighting.
                Cells(.intRow, 9).Interior.Color = vbYellow
                Cells(.intRow, 9).Font.Color = vbRed
                Cells(.intRow, 9).Value = "CREDIT"

                'Remember we need to change that quantity value in other column.
                Cells(.intRow, 6).Value = -1 'Change value from 1 to -1.
            End If 'End check for blank.
        End With
    Next intZ

    'All done with TestsToFlag, we should delete it to make sure it doesn't end up getting used on another worksheet somehow.
    Erase TestsToFlag

    'Now we can handle TestsToDelete. We have to be careful, if we delete a row at the top of the sheet, all the indexes
    'of the other rows will be off by one and so on.
    'Two ways we might manage this: 1-Instead of deleting rows, just blank them out, then use the DeleteZero macro we made earlier to clean up.
                                   '2-Instead on starting at the top we can start at the bottom and work our way up.
    'The problem with just working back up is that the rows in TestsToDelete might not be in perfectly sequential order.
    'So the safest bet is to just blank out the unwanted rows and delete all blank rows afterward.
    'Still just for the examples sake I will loop through the array in reverse so you can see how that is done.

    Dim intW As Integer
    For intW = UBound(TestsToDelete) To LBound(TestsToDelete) Step -1
        With TestsToDelete(intW)
            If .intRow > 0 And .strPatientName <> "" Then 'Something is there.
                'We know what row to delete so we could just do that here, but since this is a medical/financial macro, we'll add an extra check
                'to be sure we're deleting the right thing.
                'It is unsafe to do a direct comparison of DATE/TIME's.  So I use CDate to convert the raw cell value to a date/time.
                If Cells(.intRow, 1).Value = .strPatientName And Cells(.intRow, 3).Value = .strTestName And CDate(Cells(.intRow, 8).Value) = .dtDateTime Then
                    'Everything matches up, delete it.
                    Rows(.intRow).Clear

                Else 'Uh-oh something is wrong
                    'Alert the user and abort before you mess anything else up.
                    MsgBox "Macro tried to delete wrong row? Aborting.", vbCritical, "Macro error in HandleCredits"
                    Exit Sub
                End If 'End verify row information
            End If 'end check for blank.
        End With '(TestsToDelete)

    Next intW 'Next

    'All done, erase TestsToDelete
    Erase TestsToDelete

    'Delete blank rows
    DeleteZero

End Sub

Function SeekEvilTwin(CreditedTest As DELETEDTESTS) As DELETEDTESTS
    'This will loop through all the rows again seeking the twin.
    'If the user has run the macros in order the sort has already been performed,
    'and the original charge will be above the credited row we are working on.
    'But since we can't be sure the sort has been done we check all rows.

    intFinalRow = Range("A65536").End(xlUp).Row
    Dim intY As Integer 'Index to keep track in loop.

    'This is a For Next loop and will repeat a fixed number of times unless 'Exit For' is read.
    For intY = 2 To intFinalRow 'For each row in the report...
        If Cells(intY, 5).Value > 0 Then 'Looking for the twin with positive charge. (this will also keep us from comparing the same line to itself)
            'Compare the current row info to what we were given.
            Dim CurrentTest As DELETEDTESTS
            With CurrentTest
                .strPatientName = Cells(intY, 1).Value
                .strTestName = Cells(intY, 3).Value
                .dtDateTime = Cells(intY, 8).Value
                .intRow = intY
            End With

            'Can we compare the udt directly? A: No, because row will be different.
            With CurrentTest
                If .strPatientName = CreditedTest.strPatientName And .strTestName = CreditedTest.strTestName Then
                    'Aha! They match, but is it an evil twin or an evil cousin?
                    If .dtDateTime = CreditedTest.dtDateTime Then 'Evil twin it is
                        'We are still not done checking, multiple charge/credit pairs with the same date and time
                        'can exist, so we must make sure this row has not already been matched and saved previously

                        'LOOP THROUGH CURRENT TESTSTODELETE AND SEARCH FOR MATCH
                        If IsInTestsToDeleteAlready(CurrentTest) = True Then
                            'This row has already matched to another, continue loop search.

                        Else 'It is a match
                            'So to conclude this function, we return the current test
                            SeekEvilTwin = CurrentTest
                            Exit Function 'A chargeback can appear only once, search is over
                        End If

                    Else 'The date/time does not match, it must have been a simple credit for some other reason.
                        'Just because we found a same-named test and patient doesn't mean we can stop here.
                    End If 'End compare date/time

                Else 'The name & test did not match, do nothing and continue.
                End If 'End compare name and test.
            End With '(CurrentTest)

        Else 'The row contained a negative credit.
        End If 'End check charge amount.
    Next intY 'Next row

    'At the end of the loop all rows have been checked. We leave the default value of 0 to indicate no twin found anywhere.
    With SeekEvilTwin
        .dtDateTime = 0
        .intRow = 0
        .strPatientName = ""
        .strTestName = ""
    End With
End Function

Function IsInTestsToDeleteAlready(CurrentTest As DELETEDTESTS) As Boolean

    If UBound(TestsToDelete) <= 0 Then 'Just initialized and may be empty.
        If TestsToDelete(0).strPatientName = "" Then 'blank, empty
            IsInTestsToDeleteAlready = False
            Exit Function

        Else 'TestsToDelete has one item, continue
        End If 'end check blank TestsToDelete

    Else 'TestsToDelete is not empty
    End If 'End check TestsToDelete empty.

    Dim intX As Integer

    For intX = LBound(TestsToDelete) To UBound(TestsToDelete)
        With TestsToDelete(intX)
            If .dtDateTime = CurrentTest.dtDateTime And .intRow = CurrentTest.intRow And .strPatientName = CurrentTest.strPatientName And .strTestName = CurrentTest.strTestName Then
                IsInTestsToDeleteAlready = True
                Exit Function

            Else 'Not same, keep looking
            End If 'end compare if.
        End With

    Next intX

    IsInTestsToDeleteAlready = False 'If it got through the whole loop then there was no match.

End Function

Wow that’s a lot of code! Told you it would be complicated, but this is a great real-world example of the power of Excel vba.

Improvements are possible. For one thing, this macro makes rows of data disappear, it would be better to show the user what had been deleted. We could copy the deleted data to another worksheet or pop up a messagebox. Can you think of any other improvements?

In the final tutorial, I will show you how to make a custom drop-down menu to run the macros without having to pull up the macro dialog.

Next Tutorial: Adding custom Macro buttons to your Excel toolbar

Excel Macro Tutorial 1 – Open a text file

Excel Macro Tutorial 2 – Formatting the Columns and Column headers

Excel Macro Tutorial 3 – Remove header rows and delete junk loop

Excel Macro Tutorial 4 – Delete non-chargeable tests and sort

Excel Macro Tutorial 5 – Delete cancelled tests, flag credited tests

Excel Macro Tutorial 6 – Add macro buttons to your toolbar

One thought on “Excel Macro Tutorial 5 – Delete cancelled tests, flag credited tests

Leave a Reply

Your email address will not be published. Required fields are marked *