Bookkeeping Coding - Check and Create Tabs, Copy filtered Data in Loop

Question

As said, this is take 2 (see linked for Take 1 for my massively beginner code: https://codereview.stackexchange.com/questions/223236/)

As an overview:

I manage the bookkeeping for 40+ companies in an excel workbook. All data is added to a central sheet "Amalgamated Data" and from there data for all transactions for each Company has to be transferred to a sheet for each Company. The single company sheets are then sent to various people at various periods.

All references to the company throught the workbpook are to them as they appear as companyName.

The Code (tested and working - time scale for 40 companies on 400 rows approx 1 min) will be used at least once a day every day. It does the following:

1. Checks if there have been any transactions for that Company since the start of the financial year (list of Company’s is held in a separate continuous Column)

2. If there have been no transactions

3. If there is an existing tab, clear any transactions from it (clears out any misbookkept entries)

4. If there are no transactions, check the next company.

5. If there have been transactions:
6. Check if a sheet exists for the Company
7. If no Sheet, set up new tab by copying veryhidden Template preformatted and formula’d
8. If a sheet exists (including if set up in previous Step)

9. Check that a Balance Download Record Exists, if not create one

10. Check that an Overview Record exists, if not create one

11. Copy all transactions for that Company to the Company Sheet

I have set this in a loop as the recommendation from Iven Bach of a Dim companyName as Range For Each companyName created an error13 mismatch in the Worksheet(companyName) type with the Watch window show this as integer instead of Worksheet. I have used loop as this allows me to Dim companyName as String

Option Explicit
SUB UPDATE_BACKUP_SHEETSFIXED()
    'This Sub does the following:
    '   Filter Amalgamated Data by companyName from table list on General Sheet
    '   Then
    '   1.  If no data:
    '       a.  Check if a company Tab exists
    '            i.     If not, move on to next company
    '           ii.     If so:
    '                   1.  If there is existing data clear and move to next company
    '                   2.  If no existing data move to next company
    '   2.  Check if Company tab exists
    '       a.  If tab does not exist, create:
    '            i.  Tab
    '           ii.  Balance Download Record
    '          iii.  Overview Record
    '       b. If tab does exist (or has just been created above)
    '            i.  If there is data, Clear existing
    '           ii.  Copy transactions from Amalgamated Data Filter

    Dim amalgamatedDateSheet As Worksheet
    Set amalgamatedDateSheet = Sheets("Total Data")

    Dim sourceTable As ListObject
    Set sourceTable = amalgamatedDateSheet.ListObjects("TableFullData")

    Dim generalSheet As Worksheet
    Set generalSheet = Sheets("General")

    Dim templateSheet As Worksheet
    Set templateSheet = Sheets("Template")

    Dim balanceDownloadSheet As Worksheet
    Set balanceDownloadSheet = Sheets("Balance Download")

    Dim overviewSheet As Worksheet
    Set overviewSheet = Sheets("Overview")

    Dim X As Long
    X = 4

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False


    'Get the Company name from the Company Tab

    Do
        Dim companyName As String
        With generalSheet
            companyName = .Range("A" & X).Value
        End With

        'Clear all filter from table

        sourceTable.AutoFilter.ShowAllData

        'Filter by Company Name

        sourceTable.DataBodyRange.AutoFilter Field:=2, Criteria1:="=" & companyName

        'Check if transactions exist

        Dim firstColumnContainsNoVisibleCells As Boolean
        Dim companySheet As Worksheet
        On Error Resume Next
        Set companySheet = Sheets(companyName)
        On Error Resume Next
        firstColumnContainsNoVisibleCells = sourceTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count <= 1

        On Error GoTo 0
        If firstColumnContainsNoVisibleCells Then

            'If no transactions

            If Not companySheet Is Nothing = True Then

                'If no transactions but Tab exists for Company

                Dim targetTable As ListObject
                Set targetTable = companySheet.ListObjects(1)
                Dim firstTargetColumnContainsVisibleCells As Boolean
                On Error Resume Next
                firstTargetColumnContainsVisibleCells = targetTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count > 1

                'If Data present, clear it

                If firstTargetColumnContainsVisibleCells Then
                    With targetTable
                        .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.count - 1, .DataBodyRange.Columns.count).Rows.Delete
                        .DataBodyRange.ClearContents
                    End With
                End If

                Call CheckRecordsPresent(balanceDownloadSheet, companyName, overviewSheet)

                'If no data present move to next company

            End If

        Else
            'If transactions exist

            If Not companySheet Is Nothing = False Then

                'If tab for Company does not exist

                If templateSheet.Visible = xlSheetVeryHidden Then templateSheet.Visible = xlSheetVisible

                'Create and rename sheet highlight it yellow
                templateSheet.Copy After:=Sheets(5)
                ActiveSheet.Range("A20").ListObject.Name = "Table" & (companyName)
                ActiveSheet.Name = (companyName)
                With ActiveSheet.Tab
                    .Color = XlRgbColor.rgbYellow
                    .TintAndShade = 0
                End With
                Set companySheet = Sheets(companyName)

                'Hide template

                templateSheet.Visible = xlSheetVeryHidden

                'Confirmation Message

                MsgBox "Worksheet for " & (companyName) & " created"


            End If
            'If tab and data exist
            Call CheckRecordsPresent(balanceDownloadSheet, companyName, overviewSheet)

            'Clear existing data and resize table

            Set targetTable = companySheet.ListObjects(1)

            On Error Resume Next
            firstTargetColumnContainsVisibleCells = targetTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count > 1

            If firstTargetColumnContainsVisibleCells Then

                With targetTable
                    .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.count - 1, .DataBodyRange.Columns.count).Rows.Delete
                    .DataBodyRange.ClearContents
                End With

            End If

            'Find first row of table (last row of sheet as data previously cleared)

            Dim lastTargetRow As Long

            lastTargetRow = companySheet.Range("B" & Rows.count).End(xlUp).Row

            With sourceTable.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
                With companySheet
                    .ListObjects(1).AutoFilter.ShowAllData
                    .Range("A" & lastTargetRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone
                    Application.CutCopyMode = False
                End With
            End With
        End If

        'Loop back to get a new Company's name in Company Table

        Set companySheet = Nothing
        X = X + 1

        'Loop back to get a new Company's name in Employee Roster

    Loop While generalSheet.Range("A" & X).Value <> vbNullString

    'At end of loop turn screen refresh etc back on

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    amalgamatedDateSheet.Select

    'Clear all filter from table

    sourceTable.AutoFilter.ShowAllData
    MsgBox "All Sheets Updated"
End Sub

Private Sub CheckRecordsPresent(ByVal balanceDownloadSheet As Worksheet, ByVal companyName As String, ByVal overviewSheet As Worksheet)

    'Check Balance Download Records - create if there isn't one

    Dim lastBalanceRow As Long
    lastBalanceRow = balanceDownloadSheet.Range("a" & Rows.count).End(xlUp).Row
    Dim rangeBalanceDownloadFound As Range
    Set rangeBalanceDownloadFound = balanceDownloadSheet.Range(balanceDownloadSheet.Range("A4"), balanceDownloadSheet.Range("A" & lastBalanceRow)).Find(companyName)

    If rangeBalanceDownloadFound Is Nothing Then
        With balanceDownloadSheet
            .ListObjects(1).ListRows.Add
            .Rows(lRow).Copy
            .Range("A" & lastBalanceRow + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone
            Application.CutCopyMode = False
            .Range("a" & lRow + 1).Value = companyName
        End With
    End If

    'Check if front page record exists

    Dim lastOverviewRow As Long
    lastOverviewRow = overviewSheet.Range("a" & Rows.count).End(xlUp).Row
    Dim rangeOverviewFound As Range
    Set rangeOverviewFound = overviewSheet.Range(overviewSheet.Range("A6"), overviewSheet.Range("A" & lastOverviewRow)).Find(companyName)

    If rangeOverviewFound Is Nothing Then

        With overviewSheet
            .Range("A53:E53").Copy
            .Range("A53:E53").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Range("A53").Value = companyName
        End With
    End If
End Sub

Massive thanks to IvenBack, AJD and Mathieu Guindon for unravelling my (miraculously working) ridiculously messy previous code attempt, below is take 2 that I hope is much more streamlined and removes all (?!) of the redundant lines. Hopefully this is much improved and not too much of a bastardisation of the brilliant recommendations and codes you wrote.

All help gratefully received as I still have a long way to go.

Thanks

R

Answer 1

This code is much easier to read and understand than the last version. This is a massive leap in attaining clean code in a short amount of time.

On Errors

You have the following code:

    On Error Resume Next
    Set companySheet = Sheets(companyName)
    On Error Resume Next
    firstColumnContainsNoVisibleCells = sourceTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count <= 1

    On Error GoTo 0

Well done on removing the error trap as early as possible. You don't need the second On Error Resume Next because the first has already set the relevant conditions.

However, later in the code you set the error trap again, but do not turn it off.

        On Error Resume Next
        firstTargetColumnContainsVisibleCells = targetTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count > 1

Add an On Error Goto 0 statement in there somewhere otherwise you might hide some coding error that is relatively easy to fix and you could be hiding an error that gives you false data.

X

What is X? You have used descriptive variable names throughout the code, but one mystery remains!

If conditions

You have two lines of code which have a redundant pattern:

If Not companySheet Is Nothing = True Then
If Not companySheet Is Nothing = False Then

Later on you use a form that is cleaner:

If rangeOverviewFound Is Nothing Then

The earlier statements can be recast into a more natural form:

If Not companySheet Is Nothing Then
If companySheet Is Nothing Then

Use of Parenthesis (implicit versus explicit values)

Mathieu Guindon (@MathieuGuindon) can explain this much better than I. Using the following code line as an example:

    MsgBox "Worksheet for " & (companyName) & " created"

The '()' forces an evaluation with some side effects. It creates a value item that is passed by value (ByVal) to the routine/function. This could also bypass the intended passing by reference.

If the object in '()' is an object, then the evaluation will try to get the default value (e.g. for a Range object, it would pass the Range.Value because it is the implicit default). This, of course means that the function could get something it is not expecting thus causing errors!

In this case, companyName is a String, and the string evaluates to a string without any real issues. But develop good habits from the start.

Some additional reading:

• https://stackoverflow.com/questions/46959921/byval-vs-byref-vba
• https://stackoverflow.com/questions/22186853/unexpected-results-from-typename
• https://stackoverflow.com/questions/5413765/what-are-the-rules-governing-usage-of-brackets-in-vba-function-calls

Related - At one stage, Microsoft deprecated the Call keyword as it is a hangover from very early days of BASIC. But this is currently a matter of hot debate: https://stackoverflow.com/questions/56504639/call-statement-deprecated-or-not

Incomplete logic paths

You have If firstColumnContainsNoVisibleCells Then and then do a block of code. IF this is not true, you then do a different block of code. Which is good.

However, within the blocks of code, you check the status of companySheet. In one block you check to see if it is Nothing and in the other you check to see if is Not Nothing.

The potential issue comes if that conditional fails - what does it mean? From a coding sense, you just do nothing and that could be fine. But from a business sense, does it meant that your input is malformed. Could these blocks of code benefit from having an Else statement?

Whenever setting up a range of conditions, have a thought towards all the possibilities of the conditions. That may allow you to find inconsistent data, potential new uses for your code, or possible errors or exceptions that you can trap and fix early.

For me, an If without and Else is a sign that I must carefully review what I have done. A simple variable assignment (If X then Y=Z) is easily explained, but checking conditions for larger blocks of code means something more complex is happening.