I always seem to spend ten minutes trying to find these snippets of code on the Internet when I need them. For reference . . .

To trigger a macro on a change in range, load the procedure below into a sheet module. It will fire when a change is made to the range A1:A5.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Not Intersect(Target, Range("A1:A5")) Is Nothing Then
        Your Code Here
    End If
End Sub

To trigger a macro on a change in the sheet, load the procedure below into a sheet module. It will fire when a change is made to any cell on the sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
    Your Code Here                
End Sub

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.

Depending on how your data is grouped there are a series of options available in Excel to capture unique values. You can do so with filters, formulas, and VBA.

The macro below captures unique values from a range that spans multiple rows and columns. In the example, the source range is "A1:B20" and the output range starts with cell "D1". The macro works because, by definition, the collection variable will only accept unique values.

Sub ListUnique()

    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Cell As Range
    Dim UniqueValues As New Collection

    Set Rng1 = Range("A1:B20")
    Set Rng2 = Range("D1")

    On Error Resume Next
    For Each Cell In Rng1
        UniqueValues.Add Cell.Value, CStr(Cell.Value)
    Next Cell

    For Each Item In UniqueValues
        Rng2.Value = Item
        Set Rng2 = Rng2.Offset(1, 0)
    Next Item

End Sub