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

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.

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

‘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
End With

‘Search COMPANY nAME

Dim rgfound As Range

If rgfound Is Nothing Then

‘Calculate last row

‘Copy Last Row of Data and rename row

.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.ScreenUpdating = True
Sheets("Amalgamated Data").Select

'Clear all filter from table

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

• Where is WorksheetsExists defined, or assigned? I don't think If WorksheetsExists = Not sh Is Nothing Then is doing what you mean it to be doing, and it only works by coincidence of Variant/Empty evaluating to False when coerced into a Boolean expression. A much clearer & robust condition would be If sh Is Nothing, true when the sheet doesn't exist. Does the code compile if you add Option Explicit at the top of the module? – Mathieu Guindon Jun 30 at 22:07
• I don't think it is! I had grabbed the code from elsewhere on the t'internet (can't remember where having viewed so many sites to get to this). I was trying to establish if a worksheet with the looped name exists to run an if then else statement. I will have a go at the above. I have no idea what a Boolean is - so will take a look and learn! – rewound Jul 1 at 8:22
• A Boolean is a data type that can take one of two values - True, or False. Every expression in every If condition is a Boolean expression. That's basic-basic stuff though, you'll want to read up on VBA data types for more information. – Mathieu Guindon Jul 1 at 16:12
• Massively improved code (thanks to you all posted as new question) as advised. codereview.stackexchange.com/questions/223377 – rewound Jul 2 at 20:17
• Appreciated, thank you for the help. Post now edited to include link to new question. – rewound Jul 2 at 20:23

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 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")

Application.ScreenUpdating = 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
End With

Dim figureOutFRow As Long
figureOutFRow = 0  '<--- need to supply correct row

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.ScreenUpdating = True
amalgamatedDateSheet.Select

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

Dim rgfound As Range

If rgfound Is Nothing Then
Dim flrow As Long

.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.

• Thanks for this, I was aware of the mess of spaghetti that was left with If then else, but was at a loss to figure out how to avoid this so that code that was specifically for use when things were positive didn't execute and throw errors. As I stated above this is my first time really coding so was cobbling together bits of working code from other sources. I will test out you're code later today, but it looks much neater! – rewound Jul 1 at 8:19
• Hi Ivan thanks for this, almost works perfectly for me when I change if not companySheet is nothing then to if companySheet is Nothing then. Unfortunately I can't simply remove this line as its an integral part of the coding ie if there is data in the filtered amalgamated table but there isn't an existing companySheet then i need to create one, if there is already a sheet in that name I don't want to overwrite or create a new one as there is additional data on these sheets outside of the tables I'm pasting to. – rewound Jul 1 at 16:57
• I've also moved the End If after making the templateSheet visible after the Msgbox as otherwise it was trying to create a sheet when one already existed. I am however getting an error thrown on the next line of With companySheet.ListObjects(1) of: "Object Variable or With block variable not set". I can see this has been set higher up in a previous If statement, but adding the Set again also throws an error of "Type mismatch" so I'm at a loss as to how to move on. EDIT: It is also throwing the same error before those above edits. – rewound Jul 1 at 17:13
• That error message is RTE91 (docs.microsoft.com/en-us/office/vba/language/reference/…). It sounds like the companySheet variable isn't being assigned. In the menu at the top click Tools>Locals to display the locals window. When it errors on that line of code click Debug then look in the Locals window. If it isn't assigned you'll need to determine why and resolve that error. – IvenBach Jul 1 at 17:37
• If the variable IS being assigned but there isn't a ListObject on the sheet you'd get a RTE9 (docs.microsoft.com/en-us/office/vba/language/reference/…). – IvenBach Jul 1 at 17:39

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
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.

• I will absolutely take it in the way that it was meant! As I said I have cobbled together the code (which is my first real coding project) from Google, youtube, Macros and other answers in Stack Overflow and whilst I've tried to standardise it all, I had in some cases absolutely no idea really on how the code worked to try to re work it. I will get to updating an amending! What is the convention here as I'm a first time poster...update the code and edit the original post with amendments - subject to what I see in the next answer? Thanks again for the help. Always ways to learn :) – rewound Jul 1 at 8:12
• On some the Error GoTo handling I was actually trying to use this as a positive step. In those cases I was expecting/hoping something not to exist ie for sheet coding an action to take if the if statement was false. Ie if it doesn't exist skip out the coding that needs to happen if it does. Lesson learnt! – rewound Jul 1 at 8:26
• On Code Review, the convention is to create a new review question with the updated (and working) code. In the intro you could link back to this one to help provide the continuing story. – AJD Jul 1 at 20:35