Data cleaning #1 - Making a list of merged cells

[Dr. Demento]

I'm putting together some code that will allow me to automate data cleaning. One of the tasks I desire to do is to capture the location of any merged cell and write it to a sheet (for tracking purposes) before I unmerge the cells.

The code I have works ok, but it writes a value for each merged cell, whereas I'd like to have a single entry for each merged range. Is there a better approach to finding and logging the location of merged cells without incurring duplicates?? I'm not concerned if there are duplicates from one runtime to the next, only within a single runtime.

If my above question has no good answer, could someone assist with why I'm getting an Subscript OOR RTE in the second sub??

Sub ListMergedCells(ByVal rngUsed As Range)

Dim lrow As Integer
Dim rng As Range, _
    rngStr As Range


Worksheets("Validation").Range("A1").value = "Location (sht)"
Worksheets("Validation").Range("B1").value = "Merged Cells"
Worksheets("Validation").Range("C1").value = "Timestamp"


  For Each rng In rngUsed
    If rng.MergeCells Then
      Sheets("Validation").Cells(Rows.Count, 1).End(xlUp).Offset(1) = rng.Parent.Name
      Sheets("Validation").Cells(Rows.Count, 2).End(xlUp).Offset(1) = rng.MergeArea.address
      Sheets("Validation").Cells(Rows.Count, 3).End(xlUp).Offset(1) = Now
    End If
  Next


  If Worksheets("Validation").Range("A2") = vbNullString Then
    Exit Sub
  Else
    lrow = Sheets("Validation").Cells.Find(What:="*", _
                                After:=Range("A2"), _
                                LookAt:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False).row


    Set rngStr = Sheets("Validation").Range("A2:B" & lrow)


    Call rng_RemoveDuplicates(rngStr, Array(1, 2)) ' ~~ Delete duplicates listed under Merged Cells header
    Call UnMerge_FillBlanks(rngUsed)  ' ~~ unmerge all cells and fill with duplicate values
  End If
  
End Sub

I've attempted to use a broad, generic sub to removed duplicates (shout out to Erlandsen Data Consulting).

Sub rng_RemoveDuplicates(ByVal rngUsed As Range, _    Optional varColumns As Variant = False, _
    Optional blnHasHeader As Boolean = True)
' ~~ Remove duplicates from any sized range
' http://erlandsendata.no/?p=3715


' varColumns should be an array containing column numbers
Dim lngCount As Long, i As Long, j As Long, varItems() As Variant
    If rngUsed Is Nothing Then Exit Sub
    With rngUsed
        If Not IsArray(varColumns) Then ' check all columns in the range
            ReDim varItems(0 To .Columns.Count - 1)
            For i = 1 To .Columns.Count
                varItems(i - 1) = i
            Next i
        Else
            ReDim varItems(0 To UBound(varColumns) - LBound(varColumns) - 1) ' must be a 0-based variant array
            j = -1
            For i = LBound(varColumns) To UBound(varColumns)
                j = j + 1
                varItems(j) = varColumns(i)  [B]<------------- Subscript out of range error[/B]
            Next i
        End If
        On Error GoTo FailedToRemoveDuplicates
        If blnHasHeader Then
            .RemoveDuplicates varItems, xlYes
        Else
            .RemoveDuplicates varItems, xlNo
        End If
        On Error GoTo 0
    End With
    Exit Sub
    
FailedToRemoveDuplicates:
    If Application.DisplayAlerts Then
        MsgBox Err.Description, vbInformation, "Error Removing Duplicates From Range: " & rngUsed.address
    End If
    Resume Next
End Sub

The code that contains all the calls is Option Base 1. Not sure what I'm doing wrong.

Thanks y'all.

 

[Dr. Demento]

Of note, the rngstr.Address is $A$1:$B$2 (first sub), when there are obviously more than a header and single data entry.

In looking at the Find, I replaced it with

lrow = Sheets("Validation").UsedRange.Rows(Sheets("Validation").UsedRange.Rows.Count).row

which now gives me the proper range, but the second sub is still throwing a subscript out of range error (same place as indicated before).

I try to remove the Array(1,2) (because I'd only like the sub to use the first two columns to compare, not all of them) and I'm still left with duplicates because they have different timestamps and I'd like to have the option to deleting duplicates based on the location and range only.

Again, there's a way of listing the merged ranges without having an entry for each cell within the range, that would be my primary desire. If not, how do I restrict removal of duplicates using the sub I listed and limiting the comparison columns??

Thanks, y'all.