Bookkeeping Coding - Check and Create Tabs, Copy filtered Data in Loop - EDIT new/better code posted as new thread

Question

EDIT: Improved/More Streamlined Code (rather than spaghetti below) now posted here: Bookkeeping Coding - Check and Create Tabs, Copy filtered Data in Loop

I'm a relative newbie to coding and have "Frankensteined" my code from various pages on the web. At the moment I have no issues with this code as I have minimal lines of data but find that the time taken increases with data lines (as can only be expected.

The code I have does the following:

1. Filters a Source Table of Data from a Defined List on another sheet
2. Checks if Data exists after filter
   1. If no data exists
      1. Checks if there is a tab for that Company and deletes existing data
      2. If no tab move to next in loop
   2. If data does exists, check tab exists
      1. If tab exists, clear data and copy filtered data across move to next in loop
      2. If tab does not exist, create one from hidden template, check balance line exists in different sheet (if not create one) and then copy all filtered data and move to next in loop.
3. Remove all filters and go back to where I started.

It seems quite complex to me as a newbie so I'm sure I have a fair amount of redundant lines present that can tidy up my code.

All help/suggestions/recommendations, gratefully received.

My Code:

    Sub Update_Backup_Sheets()
    Dim sh As Worksheet
    x = 4 
    Dim LastRow As Long
    Dim MyCell As Range, MyRange As Range
    Dim lrow As Long
    Dim TargetTable As ListObject
    Dim NumberOfAreas As Long
    Dim rng As Range
    Set Sourcetable = Sheets("Amalgamated Data").ListObjects("TableFullData")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

 ‘Get the Company name from the Company Tab

    Do
    With Sheets("General")
        Company_Name = .Range("A" & x).Value
    End With

 ‘ Clear all filter from table

    Sourcetable.AutoFilter.ShowAllData
    LastRow = Range("B" & Rows.count).End(xlUp).Row - 1
    Set MyRange = Range("A20:V" & LastRow)

 ‘Filter by Company Name

    Sourcetable.DataBodyRange.AutoFilter Field:=2, _
    Criteria1:="=" & Company_Name

    On Error Resume Next
    If Sourcetable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count <= 1 Then

 ‘Clear Existing Data

     On Error GoTo Continue
        Set sh = Sheets(Company_Name)
     On Error GoTo Continue
        If WorksheetsExists = Not sh Is Nothing Then
        GoTo Continue
        Else
        With Sheets(Company_Name).ListObjects(1)
            .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.count - 1, .DataBodyRange.Columns.count).Rows.Delete
             .DataBodyRange.ClearContents
            End With
        GoTo Continue
    End If

 ‘If Data Exists
 ‘Check if tab exists

    Else

    On Error Resume Next
    If Sourcetable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count > 1 Then

    On Error Resume Next
    Set sh = Sheets(Company_Name)

    If WorksheetsExists = Not sh Is Nothing Then

‘If Tab does not exist, create all relevent records

‘Unhide Template if hidden

             If Sheets("Template").Visible = xlSheetHidden Then Sheets("Template").Visible = xlSheetVisible
 ‘Create and rename sheet highlight it yellow
                 Sheets("Template").Copy After:=Sheets(4)
                    ActiveSheet.Range("A20").ListObject.Name = "Table" & (Company_Name)
                    ActiveSheet.Name = (Company_Name)
                    With ActiveSheet.Tab
                            .Color = 65535
                            .TintAndShade = 0
                    End With

 ‘Check Balance Download Records
 ‘Search COMPANY nAME

                    Dim rgfound As Range
                    Set rgfound = Sheets("Balance Download").Range("A1", "A" & frow - 1).Find(Company_Name)

                    If rgfound Is Nothing Then

‘If not Found
‘Calculate last row

                   flrow = Sheets("Balance Download").Range("a" & Rows.count).End(xlUp).Row

 ‘Copy Last Row of Data and rename row

                    With Sheets("Balance Download")
                            .ListObjects(1).ListRows.Add
                            .Rows(flrow).Copy
                            .Range("A" & flrow + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone
                            Application.CutCopyMode = False
                            .Range("a" & flrow + 1).Value = Company_Name
                        End With
                    Else
                    End If

‘Hide template

                Sheets("Template").Visible = xlSheetHidden

‘Confirmation Message

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

‘Set sh name

            Set sh = Sheets(Company_Name)

                GoTo Step2
        Else
        End If
    End If

‘If tab and data exist

Step2:

‘Clear existing data and resize table

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

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

lrow = Sheets(Company_Name).Range("B" & Rows.count).End(xlUp).Row

    With Sourcetable.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
        With Sheets(Company_Name)
            .Range("A" & lrow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone
            Application.CutCopyMode = False
        End With
    End With

End If

Continue:
‘Reset the variable sh

Set sh = Nothing
    x = x + 1

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

Loop While Sheets("General").Range("A" & x).Value <> ""

‘At end of loop turn screen refresh etc back on

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Sheets("Amalgamated Data").Select

'Clear all filter from table

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

Answer 1

You're missing Option Explicit from the top of your code. From the menu at the top choose Tools>Options... to display the Options dialog>Code Settings group>Require Variable Declaration. Make sure that box is checked. Thereafter Option Explicit will be added to the top of all modules mandating that you do Dim fooBar as Range or whatever the appropriate data type is. Future-You will thank you because it'll help avoid silly errors like having bananna as a variable name instead of banana.

Once you have option explicit at the top of a module intentionally misspell a variable and then from the menu Debug>Compile and you'll see it in affect.

For modules that already exist you need to add this so go ahead and do that.

---

For your variable names it's usually convention to have the first word lower case and the first letter of each word upper cased. lastRow or targetTable would be examples of this.

The actual names of variables like x, rng, sh are, well, not helpful. The same is true for lrow which I'm at present assuming could be lastRow. If you rename it to be something more descriptive it will tell Future-You at a glance what it's used for.

Set nameArea = lookupSheet.Cells(startRow, lookupColumnIndex).Resize(rowSpan,1)

is much easier to understand than

Set rng = ws.Cells(x,y).Resize(z,1)

Underscores in variable names is used by the Implements statement and IMO is something that should be used only for it.

---

Indentation. You have Do then way at the end you have Loop that isn't on the same indentation level. This makes it hard to figure out should be indented. rubberduckvba.com can help you out with this and so much more. Disclosure Note: I'm a contributing member to Rubberduck.

You have a very long Sub that's doing a whole lot. If you have smaller Subs you'll notice things you didn't before. An example of things hidden in plain view several variables that, as far as I can tell aren't being used. These include MyCell, TargetTable, NumberOfAreas, rng, LastRow, and MyRange.

Others have already pointed out confusing nature of your if condition on the If...Then...Else statement If WorksheetsExists = Not sh Is Nothing Then. Since WorksheetsExists is of type Boolean which initializes as False you have False = Not sh Is Nothing Then. When sh is Nothing is evaluated you'll end up with a boolean that you can use directly. You don't need, and shouldn't, compare it to a boolean. That needlessly complicates it. Leaving it out also simplifies your code so you have If Not companySheet Is Nothing Then.

You have empty else blocks that should be removed.

Else
End If

If there's nothing in them and aren't being used remove Else key.

---

You've a On Error Resume Next before a conditional check in the if statement. My suggestion is to use the following instead. This turns on error handling for the single line and turns it off again after comparison. Just remember to assign it to false just before the loop restarts to avoid false positives.

On Error Resume Next
Dim firstColumnContainsNoVisibleCells As Boolean
firstColumnContainsNoVisibleCells = sourceTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count <= 1
On Error GoTo 0

If firstColumnContainsNoVisibleCells Then

---

You are doing a comparison using "". "" can lead you to question if the string might have contained something but was inadvertently deleted. The better way to do this uses vbNullString as it lets you know that the comparison is intentional. FooBar.Value <> vbNullString is unambiguous.

---

You're using a magic number 65535. What's the significance of that number? You only know what it is because of a comment. Going back to renaming variable names you have access to the XlRgbColor enumeration which has the member rgbYellow which is that number. Note how ActiveSheet.Tab.Color = XlRgbColor.rgbYellow is self documenting. If you're not familiar with the Enum statement have a read through it. Layman's explanation is it gives number a word to go along with it.

---

Any time a sheet was referenced multiple times with a string argument, Sheets("Template") I created a Worksheet object for it. This is because if the name is ever changed you only have to change it in that once location and not chase after it because of Run-Time error when you find out you missed one.

Below is my refactoring that I got to by incorporating all my suggestions. figureOutFRow needs to be supplied as your orginal frow is never given a value and defaults to 0.

Option Explicit

Sub Update_Backup_Sheets()
    Dim amalgamatedDateSheet As Worksheet
    Set amalgamatedDateSheet = Sheets("Amalgamated Data")

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

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

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

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

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim companyName As Range
    For Each companyName In generalSheet.Range(generalSheet.Range("A4"), generalSheet.Range("A4").End(xlDown))
        If companyName.Value2 <> vbNullString Then
            sourceTable.AutoFilter.ShowAllData
            sourceTable.DataBodyRange.AutoFilter Field:=2, Criteria1:="=" & companyName.Value2

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

            If firstColumnContainsNoVisibleCells Then
                If Not companySheet Is Nothing Then
                    With companySheet.ListObjects(1)
                        .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
                        .DataBodyRange.ClearContents
                    End With
                End If
            Else
                If Not companySheet Is Nothing Then
                    If templateSheet.Visible = xlSheetHidden Then
                        templateSheet.Visible = xlSheetVisible
                    End If

                    templateSheet.Copy After:=Sheets(4)
                    ActiveSheet.Range("A20").ListObject.Name = "Table" & companyName.Value2
                    ActiveSheet.Name = companyName.Value2
                    With ActiveSheet.Tab
                        .Color = XlRgbColor.rgbYellow
                        .TintAndShade = 0
                    End With

                    Dim figureOutFRow As Long
                    figureOutFRow = 0  '<--- need to supply correct row
                    CheckBalanceDownloadRecords balanceDownloadSheet, companyName.Value2, figureOutFRow

                    templateSheet.Visible = xlSheetHidden

                    MsgBox "Worksheet for " & companyName.Value2 & " created"
                End If

                'Clear existing data and resize table
                With companySheet.ListObjects(1)
                    .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
                    .DataBodyRange.ClearContents
                End With

                'Find first row of table (las row of sheet as data previously cleared)
                Dim lrow As Long
                lrow = companySheet.Range("B" & Rows.Count).End(xlUp).Row

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

            Set companySheet = Nothing
            firstColumnContainsNoVisibleCells = False 'To avoid false positives
        End If
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    amalgamatedDateSheet.Select

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

Private Sub CheckBalanceDownloadRecords(ByVal balanceDownloadSheet As Worksheet, ByVal companyName As String, ByVal frow As Long)
    Dim rgfound As Range
    Set rgfound = balanceDownloadSheet.Range("A1", "A" & frow - 1).Find(companyName)

    If rgfound Is Nothing Then
        Dim flrow As Long
        flrow = balanceDownloadSheet.Range("a" & Rows.Count).End(xlUp).Row

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

I really can't go any farther. This should be plenty to get you started. I'm pretty confident the If Not companySheet Is Nothing Then can actually be removed. Without being able to test it leaves it to you to step through the code and see if it actually can be removed.

Answer 2

I agree with the OP:

It seems quite complex [...] a fair amount of redundant lines present that can tidy up [the] code.

I am making an assumption that the code works - although it is hard to tell. I will also assume the line Find first row of table (las row of sheet as data previously cleared) is a typo and meant to be a comment.

I hope the OP will understand that I mean this in the nicest way: That current set of code is a mess - a dog's breakfast of spaghetti. I say this so there are no illusions - there is much to learn from this code and I doubt I will cover it all in this post.

Option Explicit

Something I repeat quite often. Always put Option Explicit at the top of the module. It prevents simple spelling errors resulting in undefined variables, and makes debugging easier because the run-time code usually gives a better error description and may even highlight the bad line of code.

In this example x is undeclared, even though it is assigned very early in the code.

Indenting

Always properly indent the code. This makes it easier to read and maintain. It also helps you check your code logic, because an unfinished loop or something inside a loop that should be outside will stand out because of the indenting.

Consistent variable use

Check when variables are being used.

• You set MyRange but I don't see it being used anywhere.
• You set Company_Name = Sheets("General").Range("A" & x).Value at the beginning of the loop, but when you check Sheets("General").Range("A" & x).Value <> "" at the end of the loop you don't reset the value. You could set Company_Name before you enter the loop, and then reset it when you get to the end of the loop, resulting in a final check of Loop While Company_Name <> "" which is easier to understand for the general reader.

This concept is about using your variable names to self-comment the code. Good variable names means that the reader understands what the code is doing without any additional comments.

The use of On Error

The spaghetti code from error handling tells me that the code logic and possible errors has not been considered. The current code is too messy to provide any specific advice. Here are some general pointers:

If you think your code is going to fail because something does not exist, then check for its existence before you enter the code. And encapsulate that error check in a function to both isolate from your code and encourage re-use. Two examples of how to check if a Worksheet exists:

Function WSExists1(wsName as String) as Boolean
Dim result as Boolean '<-- Value set by default to False
Dim tempWS as Worksheet
    For each tempWS in ThisWorkbook.Worksheets
        result = result OR (tempWS.Name = wsName)
    Next tempWS
    WSExists1 = result
End Function

Function WSExists2(wsName as String) as Boolean
Dim result as Boolean '<-- Value set by default to False
On Error Resume Next
    result = ThisWorkbook.Worksheets(wsName).Range("A1").Address = "A1"
    WSExists1 = result
End Function

Now, in your code you can use If WSExists(Company_Name) Then with great confidence and no requirement for spaghetti GoTo.

You can create similar 'helper' functions for other areas where you check for errors.

Performance

Hard to tell in the current code, but I suspect that you could dispense with the Excel Table manipulation and use arrays to work with the data. Noting that .DataRange returns an array of values anyway.

In addition, your first loop (on Company_Name) could be based on an array that your get from Sheets("General").Range("A4:A" & LastRowTBD).Value. This will assist with performance.

However, how much is redundant code and where performance tweaks can be built in will have to wait until the simpler tidy up elements have been done.