0
\$\begingroup\$

I've been working on a large spreadsheet that has many errors as options get changed and I needed a better way to know what was erroring to mitigate them. I recently learned about DI (Dependency Injection) and refactored the code in order to follow it. The code below is a utility macro that creates a table of errors.

To allow for extension if I want to have it eventually work with other workbooks.

Option Explicit
'@Folder "UtilityFeatures"

Private Enum ErrorsIn
    currentWorksheet
    currentWorkbook
End Enum

Entry method for macro. source is variant as described in GetErrorList.

Public Sub CreateTableOfErrorsInActiveWORKBOOK()
    ListErrors currentWorkbook
End Sub

Private Sub ListErrors(ByVal errorsAreIn As ErrorsIn)

    Dim inputCell As Range
    Set inputCell = GetInputCell("Select where you want the table of errors to be created")
    If inputCell Is Nothing Then GoTo CleanError

    Application.ScreenUpdating = False

    Dim source As Variant
    If errorsAreIn = currentWorkbook Then
        Set source = ActiveWorkbook.Worksheets
    ElseIf errorsAreIn = currentWorksheet Then
        source = Array(ActiveSheet)
    End If

    Const delimiter As String = "|"

    Dim errorList As Dictionary
    Set errorList = New Dictionary
    Set errorList = GetErrorList(source, delimiter)

    Dim proposedTableLocation As Range
    Set proposedTableLocation = inputCell.Resize(errorList.Count, 3)

    Dim overwrittenConstants As Long
    overwrittenConstants = GetOverwriteCount(proposedTableLocation, xlCellTypeConstants)

    Dim overwrittenFormulas As Long
    overwrittenFormulas = GetOverwriteCount(proposedTableLocation, xlCellTypeFormulas)

    If overwrittenConstants > 0 Or overwrittenFormulas > 0 Then
        Dim msg As String
        msg = "Creating the table will overwrite information. Are you sure you want to continue? There is no undo to revert the table being created"
        msg = msg & vbNewLine & vbNewLine
        msg = msg & "The proposed range for the table is " & proposedTableLocation.Address(True, True)
        Dim response As VbMsgBoxResult
        response = MsgBox(msg, vbYesNo, "Do you wish to proceed")

        If response = vbNo Then
            GoTo CleanError
        End If
    End If

    Dim columnSpan As Long
    columnSpan = UBound(Split(errorList.Item("Header"), delimiter)) + 1
    CreateTheTable inputCell, errorList, columnSpan, delimiter

CleanError:
    Application.ScreenUpdating = True
End Sub

GetInputCell is a helper function for selecting where I want tables to go. Trying to follow DRY (Don't Repeat Yourself).

Public Function GetInputCell(ByVal Prompt As String) As Range
    On Error GoTo ErrorHandler
    Set GetInputCell = Application.InputBox(Prompt, Type:=8)
    Exit Function
ErrorHandler:
    MsgBox "User Cancelled"
    Set GetInputCell = Nothing
End Function

Protection against overwriting content.

Private Function GetOverwriteCount(ByVal checkRange As Range, ByVal typeOfError As XlCellType) As Long
    On Error Resume Next
        GetOverwriteCount = checkRange.SpecialCells(typeOfError).Count
    On Error GoTo 0
End Function

Dictionary used to store information since I don't know how big the table will be beforehand. source is a variant to allow for going over allworksheets in a workbook or the single activesheet that was stuffed into an array. I know of no better way presently.

Public Function GetErrorList(ByVal source As Variant, ByVal delimiter As String) As Dictionary

    Dim errorList As Dictionary
    Set errorList = New Dictionary
    errorList.Add "Header", Join(Array("SheetName", "ErrorCells", "AreasWithErrors"), delimiter)
    Dim ws As Variant
    For Each ws In source
        Dim rngErrors As Range

        On Error Resume Next                     'Turn on error handling only for when an error range can't be found
        Set rngErrors = ws.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
        On Error GoTo 0                          'Turn off error handling

        If Not rngErrors Is Nothing Then
            Dim sheetName As String
            sheetName = ws.Name

            Dim cellAddress As String
            cellAddress = rngErrors.Address(False, False)

            Dim areaCount As Long
            areaCount = rngErrors.Areas.Count

            Dim value As String
            value = Join(Array(sheetName, cellAddress, areaCount), delimiter)

            errorList.Add errorList.Count, value
        End If

        Set rngErrors = Nothing
    Next

    Set GetErrorList = errorList
End Function

Table gets created. Note explains why it's transposed this way.

Private Sub CreateTheTable(ByVal inputCell As Range, ByVal data As Dictionary, ByVal columnSpan As Long, ByVal delimiter As String)
    Dim tblError As Range
    Set tblError = inputCell.Resize(data.Count, columnSpan)

    'Need to manually transpose since apparently a
    'Variant/String > 255 characters in length can't be done
    'Source Answer: https://stackoverflow.com/a/40157435/7420518
    'Hours spent/wasted: 3.5+
    Dim tempArray As Variant
    tempArray = data.Items
    Dim transposedArray() As String
    ReDim transposedArray(LBound(tempArray) To UBound(tempArray), 0 To 0)
    Dim i As Long
    For i = LBound(transposedArray) To UBound(transposedArray)
        transposedArray(i, 0) = tempArray(i)
    Next

    With tblError.Columns(1)
        .Value2 = transposedArray
        .TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:=delimiter
    End With

    inputCell.Parent.ListObjects.Add(xlSrcRange, tblError, XlListObjectHasHeaders:=xlYes, destination:=tblError(1, 1)).Name = "tblErrors"
End Sub
\$\endgroup\$
  • \$\begingroup\$ Oh, so you want to record the errors that occur? Rather than, say, create a list of possible errors and correct/address them? \$\endgroup\$ – Raystafarian Nov 30 '17 at 0:56
  • \$\begingroup\$ Yes. I generate the dictionary - could be anything that holds the error information. From that I create the table to persist the information as I make changes to it. Once I've made changes I'm comfortable with I'll run the macro again to create a newer more accurate table. Repeating as needed. \$\endgroup\$ – IvenBach Nov 30 '17 at 17:10
  • \$\begingroup\$ Why a dictionary instead of an array? \$\endgroup\$ – Raystafarian Dec 1 '17 at 4:22
  • \$\begingroup\$ I can't know the amount of errors beforehand. I didn't want to do the Rediming of the array and the dictionary was the solution I came up with. \$\endgroup\$ – IvenBach Dec 3 '17 at 17:46
1
\$\begingroup\$

ListErrors

TypeOf(errorsAreIn) will give you the same information as the ErrorsIn Enumerations.

Private Enum ErrorsIn
    currentWorksheet
    currentWorkbook
End Enum

Private Sub ListErrors(ByVal errorsAreIn As ErrorsIn)

But since currentWorksheet will always refer to the ActiveSheet, I would make errorsAreIn an optional parameter. If it is Nothing than refer to the ActiveSheet.

Private Sub ListErrors(Optional xlWorkbook As Workbook)
    'Some Code
    If xlWorkbook Is Nothing Then
        source = Array(ActiveSheet)
    ElseIf errorsAreIn = currentWorksheet Then
        Set source = ActiveWorkbook.Worksheets
    End If

Consider testing for Circular References

If Not rngErrors Is Nothing Then
    If Not ws.CircularReference Is Nothing Then
        Set rngErrors = Union(rngErrors, ws.CircularReference)

This code is responsible for testing whether or not there is any data in the destination range:

Dim proposedTableLocation As Range
Set proposedTableLocation = inputCell.Resize(errorList.Count, 3)

Dim overwrittenConstants As Long
overwrittenConstants = GetOverwriteCount(proposedTableLocation, xlCellTypeConstants)

Dim overwrittenFormulas As Long
overwrittenFormulas = GetOverwriteCount(proposedTableLocation, xlCellTypeFormulas)

Private Function GetOverwriteCount(ByVal checkRange As Range, ByVal typeOfError As XlCellType) As Long
    On Error Resume Next
        GetOverwriteCount = checkRange.SpecialCells(typeOfError).Count
    On Error GoTo 0
End Function

If overwrittenConstants > 0 Or overwrittenFormulas > 0 Then

Alternatively, you code do this:

If WorksheetFunction.CountA(inputCell.curreCurrentRegion) > 0 Then

Overwriting a table with fewer rows than the original table will throw a 1004, "A table cannot overlap another table." Error.

Here is how you can avoid the 1004 Error:

inputCell.CurrentRegion.Clear

GetErrorList

By declaring ws as Worksheet, you will be able to use Intellisense and still iterate over your source array.

Dim ws As Worksheet
For Each ws In source

As my optometrist would say: "Which is clearer?"

↓This↓

Dim sheetName As String
sheetName = ws.Name

Dim cellAddress As String
cellAddress = rngErrors.Address(False, False)

Dim areaCount As Long
areaCount = rngErrors.Areas.Count

Dim value As String
value = Join(Array(sheetName, cellAddress, areaCount), delimiter)

errorList.Add errorList.Count, value

Or ↓This↓

Dim values As Variant
value = Array(ws.Name, rngErrors.Address(False, False), rngErrors.Areas.Count)
errorList.Add errorList.Count, Join(values, delimiter)

↑This↑ or ↓This↓

errorList.Add errorList.Count, Join(Array(ws.Name, rngErrors.Address(False, False), rngErrors.Areas.Count), delimiter)

Not much difference, I would choose the later and save 10 lines of code.

With a few changes you could include the number of cells with errors in the output.

  • errorList.Add "Header", Join(Array("SheetName", "ErrorCells", "AreasWithErrors","NumOfCells"), delimiter)
  • value = Join(Array(sheetName, cellAddress, areaCount, rngErrors.CountLarge), delimiter)

Sample Output


Since you never use the Keys of the Dictionary, I would have used an ArrayList.

ArrayList Instantiation

Dim errorList As Object
Set errorList = CreateObject("System.Collections.ArrayList")

Adding values to the ArrayList

errorList.Add value

Retrieving the values from the ArrayList

tempArray = errorList.ToArray
| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Use of CurrentRegion will include anything adjacent to it leading to false positives at times. I've had it happen before. ws as Worksheet is what I would usually do. Unfortunately running on the ActiveSheet caused it to error out, which led to me using Variant. I did use Worksheet to code it to and changed it once I was done. ArrayList is a much better fit in place of Dictionary. \$\endgroup\$ – IvenBach Dec 7 '17 at 0:56
  • \$\begingroup\$ Good point about CurrentRegion. Alternatively If WorksheetFunction.CountA(inputCell.Resize(errorList.Count, 3)) > 0 Then will work. However, there is still a problem with overlapping tables. Personally, I would avoid the user input by either creating another workbook for the report or adding a worksheet. Of course it is your project and I don't know all of the considerations. \$\endgroup\$ – user109261 Dec 7 '17 at 10:52

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.