Archive for the ‘VBA’ Category.

Connection Properties of External Data Ranges

I have a workbook with several connections to SQL Server. When I need to change the SQL statement, I do that in Connection Properties.

I added a command to the QAT to show the connection properties dialog, but there’s something I don’t like about it. If I’m in a table with a connection, it’s pretty likely that I want to see the properties of that particular connection and not just a list of all connections. Of course I’m awesome at naming my connections so I don’t have to guess which is which, but if you weren’t so awesome you might have trouble distinguishing them.

The long-term answer is to write my own interface to change the things I want to change. But in the mean time, I want to open the connections dialog and highlight the connection related to the table I’m in, if any.

Public Sub ShowConnection()
    Dim qt As QueryTable
    Dim sConName As String
    Dim i As Long
    On Error Resume Next
        Set qt = ActiveCell.ListObject.QueryTable
    On Error GoTo 0
    If Not qt Is Nothing Then
        sConName = qt.WorkbookConnection.Name
        Application.CommandBars.ExecuteMso "Connections"
        Application.Wait Now + TimeSerial(0, 0, 2)
        For i = 1 To Len(sConName)
            SendKeys Mid$(sConName, i, 1)
        Next i
        Application.CommandBars.ExecuteMso "Connections"
    End If
End Sub

When I open the Connections dialog, I can start typing the name of the connection to get down to it. For example, I could start typing “dup” and it will highlight the first connection that starts with those keys.

With SendKeys, I can type the entire name. First I see if the ActiveCell is in a QueryTable. If it’s not, I just open the dialog. If it is, I open the dialog, wait a couple seconds, then send all the keys in the connection’s name. SendKeys can be very dangerous, but we’re just experimenting here.

What the above code actually does is open the Connections dialog, wait for it to close, then send all those keystrokes into the ActiveCell. Dangerous. And not helpful. Apparently the Connections dialog is modal and all code is suspended until it’s closed. I did a little searching and found this command, which does not help.


Maybe the old CommandBars behave differently than the Ribbon.

Application.CommandBars.FindControl(, 11205).Execute

Nope. Same as ExecuteMso. One last try. This opens the dialog with SendKeys.

        sConName = qt.WorkbookConnection.Name
        SendKeys "%ao"
        Application.Wait Now + TimeSerial(0, 0, 2)
        For i = 1 To Len(sConName)
            SendKeys Mid$(sConName, i, 1)
        Next i

And it works. For some reason sending Alt+A+O opens the Connections dialog modeless, the SendKeys executes, and takes me to the “active” connection. I have a couple of applications on my machine that like to steal the focus, so I try to avoid SendKeys whenever I can (which is always). In this code, I’m using it twice, so I won’t be using it all. Interesting, though, that it seems to be the only way to get what I want.

Along the way, I discovered I could get to the “active” connection’s property sheet with this key sequence:

  1. right-click key
  2. b
  3. a
  4. tab
  5. tab
  6. enter

I guess that will work. It’s a lot of keystrokes, though.

MaxMinFair Rewrite

I read Charles William’s MaxMinFair algorithm and I didn’t like his approach. That’s typical. I’ll read somebody’s code and think “They’re making that too hard”. Then I’ll set about rewriting it. In this case, as in most cases, it turns out that it is that hard, but I wasn’t going to convince myself until I tried it. I ended up with a different approach that’s not shorter, not easier to read, and not easier to follow. Oh well, here it is anyway.

Function MaxMinFairDK(Supply As Double, Demands As Variant) As Variant
    Dim dPrior As Double
    Dim vaReturn As Variant
    Dim dAvailable As Double
    Dim i As Long, j As Long
    Dim dTemp As Double
    Dim wf As WorksheetFunction
    On Error GoTo ErrHandler
    Set wf = Application.WorksheetFunction
    If IsObject(Demands) Then Demands = Demands.Value2 'make range array
    dAvailable = Abs(Supply) 'ignore negative supplies
    If Not IsArray(Demands) Then
        'One demand = min of supply or demand
        MaxMinFairDK = Array(dAvailable, Demands)(Abs(dAvailable > Demands))
        'Excel returns NA when you use too many columns
        If UBound(Demands, 2) > 1 Then Err.Raise xlErrNA
        'Assume everybody gets everything they want
        ReDim vaReturn(LBound(Demands, 1) To UBound(Demands, 1), 1 To 1)
        vaReturn = Demands
        For i = UBound(Demands, 1) To LBound(Demands, 1) Step -1
            'If there's enough, do nothing except reduce what's available
            If dAvailable / i > (wf.Large(Demands, i) - dPrior) Then
                dAvailable = dAvailable - ((wf.Large(Demands, i) - dPrior) * i)
                dPrior = wf.Large(Demands, i)
                'Once there's not enough, everyone splits what's left
                For j = LBound(Demands, 1) To UBound(Demands, 1)
                    If Demands(j, 1) > dPrior Then
                        vaReturn(j, 1) = dPrior + (dAvailable / i)
                    End If
                Next j
                Exit For
            End If
        Next i
        MaxMinFairDK = vaReturn
    End If
    Exit Function
    MaxMinFairDK = CVErr(Err.Number)
    Resume ErrExit
End Function

In Charles’s implementation, he allocates an equal amount of the supply to each node, then takes back what that node didn’t need and puts it back in the available pool. When I was looking at the results, I was thinking that the smallest n nodes simply get their demand and only when there’s not enough to go around do we need to do something different than allocate the full demand.

In my implementation, I start by giving everyone what they demand. Then I start with the smallest demand, and if I can accommodate that amount for everyone, I just reduce the amount available and move to the second smallest demand. At some point (the sixth smallest demand in Charles’s data) I can’t meet that demand and still give everyone an equal share. At that point, I give anyone who hasn’t had their demand met an equal amount – the amount that’s already been distributed plus an equal share of what’s left.

Rank Demand Incremental Demand Allocated Remaining
7 0.70 0.70 4.90 13.40
6 1.00 0.30 1.80 11.60
5 1.30 0.30 1.50 10.10
4 2.00 0.70 2.80 7.30
3 3.50 1.50 4.50 2.80
2 7.40 3.90 7.80 (5.00)
1 10.00 2.60 2.60 (7.60)

In the first iteration, I hand out 0.70 to everyone because I have enough supply to do that. In the second iteration, I had out the differential, 0.30, to everyone who’s left because I have enough supply remaining. When I get to #2, I can’t hand out 3.90 to the remaining two nodes because I don’t have enough supply. I’ve allocated up to 3.5 to anyone who’s demanded it, so the last two get the 3.5 plus half of the 2.8 that remains.

Although I didn’t accomplish anything, it was still a fun exercise.

From True and False to Yes and No

I’m writing some code to turn the contents of class modules into an XML file for Affordable Care Act compliance purposes. The XML file spec says that my flag for whether the dependent is a spouse is “Y” or “N”. In my class, I have a Relation property that can be “Son”, “Daughter”, or “Spouse”. I made a new property to return the “Y” or “N”.

Public Property Get IsSpouseXML() As String
    If Me.Relation = "Spouse" Then
        IsSpouseXML = "Y"
        IsSpouseXML = "N"
    End If
End Property

I hate writing all those lines to convert a Boolean into something else. I know it’s not that big of a deal, but it just bugs me. So I fixed it.

Public Property Get IsSpouseXML() As String
    IsSpouseXML = Split("N Y")(Abs(Me.Relation = "Spouse"))
End Property

Now that’s fancy. The comparison is made and the True or False is converted to a Long via the Abs() function (to turn True to 1 instead of -1) and the proper element of the array is selected. It’s still not good enough.

Public Property Get IsSpouse() As Boolean
    IsSpouse = Me.Relation = "Spouse"
End Property

Public Property Get IsSpouseXML() As String
    IsSpouseXML = Split("N Y")(Abs(Me.IsSpouse))
End Property

Yeah, that’s better. But it’s so specific to spouses. Spouse is a dependent that gets special attention, so I don’t mind having a dedicated property to it. It’s appropriate for the domain, I think. But if I wanted to really generalize the hell out of it, I might make an IsRelation property and then take my conversion property into a function.

Public Property Get IsRelation(ByVal sRelation As String) As Boolean
    IsRelation = Me.Relation = sRelation
End Property

Public Function ConvertBool(bValue As Boolean, vArr As Variant) As String
    ConvertBool = vArr(Abs(bValue))
End Function

Now I can have complete customization of the return string.

Public Sub TEST_IsSpouse()
    Dim clsDep As CDependent
    For Each clsDep In gclsEmployees.Employee(4).Dependents
        Debug.Print ConvertBool(clsDep.IsRelation("Spouse"), Array("Not so much", "Of course")), clsDep.Relation
    Next clsDep
End Sub

Searching Text Files in a Directory

I have several years of vendor invoices, in text file format, in some directories on a share. I need to search through these text files to find an order number, manifest number, or some other piece of information. I can’t search everything because it would take too long. And I don’t have control over the server, so if there is some indexing that could be done, I can’t do it. I’m stuck with good old VBA.

The folders are yyyymmdd (ex: 20150725 for July 25th) and corresponds to the invoice dates for any invoices in the file. Each file starts with a three letter abbreviation of the vendors name. Invoice date and vendor name are the only two pieces of information I can use to limit the search. The final piece of information is, of course, the search term. Here’s what the form looks like

I have a table of vendors and codes to populate the Vendor combobox. The QuickDate combobox populates the Date Range textboxes and contains common date ranges, namely, Last Month, This Month, Last Quarter, This Quarter, Last Year, This Year. I can change the dates to whatever I want if there isn’t a Quick Date that suits me. The Search Terms textbox takes a space separated list of terms to search for.

And now the fun part. The code. This converts the Quick Dates into real dates

Private Sub cbxQuick_Change()
    Dim dtStart As Date, dtEnd As Date
    Select Case Me.cbxQuick.Value
        Case "Last Month"
            dtStart = DateSerial(Year(Now), Month(Now) - 1, 1)
            dtEnd = DateSerial(Year(Now), Month(Now), 0)
        Case "This Month"
            dtStart = DateSerial(Year(Now), Month(Now), 1)
            dtEnd = DateSerial(Year(Now), Month(Now) + 1, 0)
        Case "Last Quarter"
            dtStart = DateSerial(Year(Now), Month(Now) - (((Month(Now) - 1) Mod 3) + 3), 1)
            dtEnd = DateSerial(Year(dtStart), Month(dtStart) + 3, 0)
        Case "This Quarter"
            dtStart = DateSerial(Year(Now), Month(Now) - (((Month(Now) - 1) Mod 3)), 1)
            dtEnd = DateSerial(Year(dtStart), Month(dtStart) + 3, 0)
        Case "Last Year"
            dtStart = DateSerial(Year(Now) - 1, 1, 1)
            dtEnd = DateSerial(Year(Now), 1, 0)
        Case "This Year"
            dtStart = DateSerial(Year(Now), 1, 1)
            dtEnd = DateSerial(Year(Now) + 1, 1, 0)
    End Select
    Me.tbxStartDate.Text = Format(dtStart, "mm/dd/yyyy")
    Me.tbxEndDate.Text = Format(dtEnd, "mm/dd/yyyy")
End Sub

This makes sure a real date is entered, but provides for 6 or 8 digit date entry.

Private Sub tbxEndDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If IsDate(Me.tbxEndDate.Value) Then
        tbxEndDate.Text = FormatDateTime(tbxEndDate.Value, vbShortDate)
    ElseIf Len(tbxEndDate.Text) = 6 Then
        tbxEndDate.Text = DateSerial(Right(tbxEndDate.Text, 2), Left(tbxEndDate.Text, 2), Mid(tbxEndDate.Text, 3, 2))
    ElseIf Len(tbxEndDate.Text) = 8 Then
        tbxEndDate.Text = DateSerial(Right(tbxEndDate.Text, 4), Left(tbxEndDate.Text, 2), Mid(tbxEndDate.Text, 3, 2))
        MsgBox "You must enter a valid date."
        Cancel = True
    End If

End Sub

And the big one, the actual search. This is pretty long and needs to be refactored, but it works for now.

Private Sub cmdSearch_Click()
    Dim vaTerms As Variant
    Dim i As Long, j As Long
    Dim aFolders() As String
    Dim sFolder As String, sFile As String, lFile As Long
    Dim lCnt As Long
    Dim dtFolder As Date
    Dim sText As String
    Const sPATH As String = "\\yourserver\rawdata\"
    ReDim aFolders(1 To 1000)
    sFolder = Dir(sPATH & "*", vbDirectory)
    'get a list of folders in the date range
    Do While Len(sFolder) > 0
        If Len(sFolder) = 8 Then
            dtFolder = DateSerial(Left$(sFolder, 4), Mid$(sFolder, 5, 2), Right$(sFolder, 2))
            If dtFolder >= CDate(Me.tbxStartDate.Text) And dtFolder <= CDate(Me.tbxEndDate.Text) Then
                lCnt = lCnt + 1
                aFolders(lCnt) = sFolder
                sFolder = Dir
            End If
        End If
        sFolder = Dir
    ReDim Preserve aFolders(1 To lCnt)
    lCnt = 0
    vaTerms = Split(Me.tbxSearch.Text, Space(1))
    'Make a dummy result
    Me.lbxResults.AddItem vbNullString
    For i = LBound(aFolders) To UBound(aFolders)
        sFolder = sPATH & aFolders(i) & "\"
        sFile = Dir(sFolder & Me.cbxVendor.Value & "*.IN?")
        Do While Len(sFile) > 0
            'Show the current folder as a result
            Me.lbxResults.Column(0, 0) = sFolder & sFile
            'Open the file and read in all the text
            lFile = FreeFile
            Open sPATH & aFolders(i) & "\" & sFile For Binary As lFile
                sText = Space$(LOF(lFile))
                Get #1, , sText
            Close lFile
            'Loop through the space separated search terms and see if
            'they're in the file
            For j = LBound(vaTerms) To UBound(vaTerms)
                If InStr(1, sText, vaTerms(j), vbTextCompare) > 0 Then
                    'This is the animation part
                    Me.lbxResults.AddItem vbNullString, 0
                    Me.lbxResults.TopIndex = 0
                    lCnt = lCnt + 1
                    Exit For
                End If
            Next j
            sFile = Dir
    Next i
    'Get rid of the dummy
    Me.lbxResults.RemoveItem 0
End Sub

It takes about 60 seconds per month to search the files. That’s a long time so it’s necessary to entertain the user while he waits. The top entry in the results listbox is whatever the current file is. It rapidly changes the display as it loops through the folder. When there’s a hit, that file becomes the second entry and any prior hits move down. This little animation lets the user know that it’s still working and gives him a list of what hits have been found already.

You can download

Setting the Tab Order of Userform Controls Programmatically

I hate designing userforms. I mean the part where I’m lining up controls, renaming controls, and all the other super-fiddly parts of making a form look and act right – like setting the tab order. I always wait until the very end so I don’t have to do it twice. And that Tab Order dialog? Forget about it.

When I’m finally ready to set the tab order, I find the first control and click Move Up until it’s at the top. Next, I find the second control and click Move Up until it’s just below the first control. Then I go to Whammyburger and force them to serve me breakfast. Then I go back and do the rest of the controls. It’s maddening. I decided finally to do something about it.

First I set a reference to the VBA Extensibility Library.

Then I put this code in a standard module

Public Sub FixTabOrder()
    Dim ctl As Control
    Dim i As Long, j As Long
    Dim lCnt As Long
    Dim vbc As VBIDE.VBComponent
    'Change this to the name of your userform
    Set vbc = ThisWorkbook.VBProject.VBComponents("UInvoice")
    For i = 1 To vbc.Properties("Width")
        For j = 1 To vbc.Properties("Height")
            For Each ctl In vbc.Designer.Controls
                If ctl.Top = i And ctl.Left = j Then
                    ctl.TabIndex = lCnt
                    lCnt = lCnt + 1
                End If
            Next ctl
        Next j
    Next i
    For Each ctl In vbc.Designer.Controls
        Debug.Print ctl.Name, ctl.TabIndex
    Next ctl
End Sub

This is pretty brute force, but it only take a few seconds to run, so who cares. The i and j variables move through the userform point-by-point, left to right, top to bottom (that’s the typographical point, not the agenda items point). For every point on the userform, it loops through every control to see if that control starts at that point. If it finds one, it sets the controls TabIndex to the next number. At the end it just prints out the control names and tabs.

Even if that’s not exactly how I want my tab order, it gets it close and I can make other modifications manually.

If you have a super-wide or super-long form, it will take longer. The right way to do this is to put all the controls in an array and sort them by their Top and Left properties. If this method is too slow, you should write that up. Then send me a copy.

Document Not Saved Error on ExportAsFixedFormat

Recently, I was accusing ExportAsFixedFormat of causing a problem with some code. It turned out to not be the culprit. But I was suspicious because I very often get a Document Not Saved runtime error when I export to PDF in a loop. When I get that error, I can click Debug and F5, and it happily continues until it errors again. Of course, watching something loop eighty-six times to make sure it doesn’t error kind of defeats the purpose of the loop. Today, I took a stand.

I have this code that changes the page fields on a pivot table and exports a range. The result is eighty-six PDFs in a folder that I sew together into one big report. There are two page fields, so there are two loops. Here’s the inner loop.

For Each rCell In .Range(.Cells(vaRows(i), 2), .Cells(vaRows(i), 2).End(xlDown)).Cells
    pt.PivotFields("Final").CurrentPage = rCell.Value
    wshDashFuelCust.Range("AK7").Resize(62, 4).ExportAsFixedFormat xlTypePDF, sPath & rCell.Value & "_" & aProducts(i)
Next rCell

You see my pathetic DoEvents attempt at avoiding the error. The error stops on the ExportAsFixedFormat line, so the DoEvents doesn’t actually help. When the error happens, a .tmp file is left in the directory. And when I do the Debug, F5 thing, the .tmp file stays there forever. Clearly this is a temporary file that would someday become a PDF if not for this error.

The .tmp file is my evidence that the processed finished. I can ignore the error and as long as there is no temp file, I’ll know the error never occurred. I rewrote the loop thusly:

For Each rCell In .Range(.Cells(vaRows(i), 2), .Cells(vaRows(i), 2).End(xlDown)).Cells
    pt.PivotFields("Final").CurrentPage = rCell.Value
        On Error Resume Next
            Kill sPath & Dir(sPath & "*.tmp")
            wshDashFuelCust.Range("AK7").Resize(62, 4).ExportAsFixedFormat xlTypePDF, sPath & rCell.Value & "_" & aProducts(i)
        On Error GoTo 0
    Loop While Len(Dir(sPath & "*.tmp")) > 0
Next rCell

As long as there’s a file with a tmp extension, I keep trying to export. The Kill statement needs to be inside the On Error because there won’t be anything to Kill the first time.

After a rigorous test of one time, it worked. I should have put a little loop counter in there to see how many times it errored. And maybe to exit out in case it gets into an infinite loop situation.

Converting SUMs to SUBTOTALs

Everyone knows that SUBTOTAL ignores filtered rows. Readers of DDoE know that SUBTOTAL also ignores other SUBTOTAL formulas. I tell everyone who will listen about the benefits of SUBTOTAL. It’s one of the best received tips in the ‘Tips and Tricks’ portion of the training I do. But I still get spreadsheets that use SUM and individual adding of cells. When I do, I convert them to SUBTOTAL to make sure there are no errors. Today, I decided to automate that process.

I’ve filled column B over to the right into column C so I can preserve the original data.

With Excel’s color coding and this simple worksheet, you may have spotted the error in the grand total formula. Below is the code I wrote to correct this situation without having to put in all the SUBTOTALs manually.

Public Sub ConvertSumToSubtotal()
    Dim rCell As Range
    Dim rStart As Range
    Const sSUM As String = "=SUM("
    'Only work on ranges
    If TypeName(Selection) = "Range" Then
        'Only work on single columns
        If Selection.Columns.Count = 1 Then
            'rStart will adjust to be where ever the SUBTOTAL range will start
            Set rStart = Selection.Cells(1)
            'loop through the cells and replace SUM with SUBTOTAL
            'change rStart to point to cell just below the SUBTOTAL
            For Each rCell In Selection.Cells
                If rCell.HasFormula And Left(rCell.Formula, 5) = sSUM Then
                    rCell.Formula = "=SUBTOTAL(9," & rStart.Address(0, 0) & ":" & rCell.Offset(-1, 0).Address(0, 0) & ")"
                    Set rStart = rCell.Offset(1, 0)
                End If
            Next rCell
        End If
    End If
    'Make the last cell a SUBTOTAL of the whole range
    Selection.Cells(Selection.Rows.Count).Formula = "=SUBTOTAL(9," & Selection.Resize(Selection.Rows.Count - 1, 1).Address(0, 0) & ")"
End Sub

This won’t work in every situation, but this layout is the one I see the most. This layout being SUMs for the subtotals and a big =A1+A2+A3 style formula for the grand total.

Once again SUBTOTAL saves the day and fixes the error. The most common error I see with this layout is in the grand total, but not always. Sometimes the subtotals don’t cover the correct range. It would seem easier when replacing the SUMs to use the same range the SUM uses, but I wanted to make sure I fixed any of those errors too. To do that, I SUBTOTAL from the cell below the previous SUBTOTAL to the cell above the current one.

Pro tip: Use Ctrl+` to toggle between viewing formulas and values (that’s an accent grave, left of the 1 key on US keyboards).

Excel Is Waiting for another Application to Complete an OLE Action

Have you ever seen this message? It’s not an error. You can’t click Debug and go see which line of code it’s on when this happens. You can’t even click Cancel. All you can do is click OK every 10 seconds or so until it’s done. Brutal.

I ran into this message recently on some code that someone else wrote but that I’d modified (see how I’m already deflecting the blame). The code runs through a hundred or so customers and sends them an email. Each customer has its own worksheet and that worksheet is turned into HTML to be used in the body of the email. Incidentally they used Ron de Bruin’s RangeToHTML function to do the conversion. I happened to have written that function back when I had a website called Ah, memories.

The code I modified was working well for a few weeks before it started acting up. One line in the code looks like this

sh.ExportAsFixedFormat xlTypePDF, sAttachFile

That saves the sheet as a PDF. I use the ExportAsFixedFormat method a lot in loops and I get the Run-time error 1004. Document not saved. the document may be open, or an error may have been encountered when saving error every so often. When I get this error I hit Debug and F5 and everything works fine. I know it’s a timing issue, but haven’t taken the time to figure out how to avoid it. It started happening on this customer email workbook. I couldn’t hardly ask a normal user to click Debug, F5, and close the VBE when it’s done. I’m not a monster.

I put a one second delay before line to allow Windows to have time to release the file lock or whatever the heck is going on. It only executes on about seven of the 100 customers, so it makes a 10 second procedure run in 17 seconds. We can live with that. And it worked. No more errors.

Everything was fine until the OLE Action message started popping up a couple days later. Of course when anything goes wrong after a code change, you have to blame the code change. The angry villagers were at my door demanding that the one second delay be removed. I wasn’t convinced (spoiler: I’m the hero in this story). I sat at the user’s computer, ran the code, and got the message. I changed the status bar to show me which customer it was on when the message appears. When I ran the code again, it was on Vandelay Industries. We looked at some past Vandelay emails and we noticed that the format was all messed up in yesterday’s email, but otherwise looked OK. Formatting problems don’t cause OLE messages, so I ignored it.

I did some Binging and saw my old buddy Shane Devonshire recommended checking the Ignore other applications that use Dynamic Data Exchange checkbox in Tools – Options. I could tell he was grasping at straws, but I was at the straw-grasping stage, so I went with it. I ran the code for the third time (a tedious process because of all the OLE messages) and it got stuck on Vandelay Industries again. A clue!

I discussed this new information with the user. Since Vandelay did not get a pdf attachment, I concluded that the problem was Outlook and not whatever generates PDFs from Office. Maybe we messed up the email address and Outlook was churning away trying to resolve it. Nope, no change there. But he did mention that he added a note to the bottom of their worksheet. More specifically, he copied the note from another customer’s sheet and pasted it to Vandalay’s. Oh, and one other thing. When he pasted the message, he accidentally selected the entire row, which put the message in every cell in that row, rather than just the first one. But he deleted all the extraneous messages, so it was fine.

“Aha!”, I said. I went to their sheet and pressed Ctrl+End. That took me to cell XFD92. In the code, the (now enormous) UsedRange was being passed to RangeToHTML. I went to the Outbox in Outlook and there was a 43MB message sitting there staring back at me. The OLE Action that Excel was waiting for Outlook to complete was rending 43MBs of HTML in a message.

The quick fix was to delete all the columns in that sheet that I didn’t want, save, close, and reopen. Fixed. As for the code, it’s tempting to use an alternative method for finding the real used range. That solves the email problem, but it doesn’t fix the root of the problem – a messed up UsedRange that’s unnecessarily bloating the file.

In the end, I decided to test the number of columns and rows in the UsedRange, and if they’re over a threshold, raise an error. That will allow the user to fix the root and rerun the procedure.