In a medical practice, billing codes are typically arranged in a hierarchy. CPT4 codes are at the top tier with procedure codes as a secondary tier. Each procedure code is attached to a fee. Although the procedure codes can differ, generally all fees within the same CPT4 range should be the same.

Most practices have many thousands of procedure codes and fees in their billing systems. Due to the nature of data input, as these database grow the odds of input errors also grow. For that reason it is necessary to periodically audit the data in the system for error.

The screenshot below shows a simple database containing CPT4 codes, procedure codes, and fees. The arrows indicate fees that were entered in error.

Without some automated process, finding these errors can be extremely time consuming and costly. If not found in a timely manner, bills with errors are sent to patients which require adjustments once found.

The macro below helps to automate the process of finding these errors. The macro scans the first column for like CPT4 codes. It then takes the average of all of the fees corresponding to those CPT4 codes. If the average differs from the last fee in the CPT4 range, the corresponding data range is highlighted in yellow signifying a data input error.

Sub FlagErrors()
    Dim Rng As Range
    Dim Cnt As Integer
    Dim Avg As Variant
    Dim Oset As Integer
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    
    '******
    'Inputs
    '******
    '(1) Sets the Search Range at Column A
    Set myRange = ActiveSheet.Range("A2:A" & LR)
    '(2) Sets the Data Range as the Offset to Column A
    Oset = 2
    '******
    
    Cnt = 1
    For Each Rng In myRange
        If Cnt = 1 Then X = Rng.Offset(0, Oset).Address
        If Rng.Value = Rng.Offset(1, 0).Value Then
            Cnt = Cnt + 1
            Rng = Rng.Offset(1, 0)
        ElseIf Rng.Value <> Rng.Offset(1, 0).Value Then
            Y = Rng.Offset(0, Oset).Address
            Cnt = 1
            Set CodeRange = Range(X & ":" & Y)
            Avg = Application.WorksheetFunction.Average(CodeRange)
            If Avg <> Rng.Offset(0, Oset).Value Then
                CodeRange.Interior.ColorIndex = 6
            End If
        End If
    Next Rng
End Sub

The audited spreadsheet looks like the one below. At this point the errors can be quickly corrected.