k7xcgHva

1Sub Update_Backup_Sheets()
2    Dim sh As Worksheet
3    x = 4 
4    Dim LastRow As Long
5    Dim MyCell As Range, MyRange As Range
6    Dim lrow As Long
7    Dim TargetTable As ListObject
8    Dim NumberOfAreas As Long
9    Dim rng As Range
10    Set Sourcetable = Sheets("Amalgamated Data").ListObjects("TableFullData")
11
12    Application.ScreenUpdating = False
13    Application.DisplayAlerts = False
14
15 ‘Get the Company name from the Company Tab
16
17    Do
18    With Sheets("General")
19        Company_Name = .Range("A" & x).Value
20    End With
21
22 ‘ Clear all filter from table
23
24    Sourcetable.AutoFilter.ShowAllData
25    LastRow = Range("B" & Rows.count).End(xlUp).Row - 1
26    Set MyRange = Range("A20:V" & LastRow)
27
28 ‘Filter by Company Name
29
30    Sourcetable.DataBodyRange.AutoFilter Field:=2, _
31    Criteria1:="=" & Company_Name
32
33    On Error Resume Next
34    If Sourcetable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count <= 1 Then
35
36 ‘Clear Existing Data
37
38     On Error GoTo Continue
39        Set sh = Sheets(Company_Name)
40     On Error GoTo Continue
41        If WorksheetsExists = Not sh Is Nothing Then
42        GoTo Continue
43        Else
44        With Sheets(Company_Name).ListObjects(1)
45            .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.count - 1, .DataBodyRange.Columns.count).Rows.Delete
46             .DataBodyRange.ClearContents
47            End With
48        GoTo Continue
49    End If
50
51 ‘If Data Exists
52 ‘Check if tab exists
53
54    Else
55
56    On Error Resume Next
57    If Sourcetable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count > 1 Then
58
59    On Error Resume Next
60    Set sh = Sheets(Company_Name)
61
62    If WorksheetsExists = Not sh Is Nothing Then
63
64‘If Tab does not exist, create all relevent records
65
66‘Unhide Template if hidden
67
68             If Sheets("Template").Visible = xlSheetHidden Then Sheets("Template").Visible = xlSheetVisible
69 ‘Create and rename sheet highlight it yellow
70                 Sheets("Template").Copy After:=Sheets(4)
71                    ActiveSheet.Range("A20").ListObject.Name = "Table" & (Company_Name)
72                    ActiveSheet.Name = (Company_Name)
73                    With ActiveSheet.Tab
74                            .Color = 65535
75                            .TintAndShade = 0
76                    End With
77
78 ‘Check Balance Download Records
79 ‘Search COMPANY nAME
80
81                    Dim rgfound As Range
82                    Set rgfound = Sheets("Balance Download").Range("A1", "A" & frow - 1).Find(Company_Name)
83
84                    If rgfound Is Nothing Then
85
86‘If not Found
87‘Calculate last row
88
89                   flrow = Sheets("Balance Download").Range("a" & Rows.count).End(xlUp).Row
90
91 ‘Copy Last Row of Data and rename row
92
93                    With Sheets("Balance Download")
94                            .ListObjects(1).ListRows.Add
95                            .Rows(flrow).Copy
96                            .Range("A" & flrow + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone
97                            Application.CutCopyMode = False
98                            .Range("a" & flrow + 1).Value = Company_Name
99                        End With
100                    Else
101                    End If
102
103‘Hide template
104
105                Sheets("Template").Visible = xlSheetHidden
106
107‘Confirmation Message
108
109                 MsgBox "Worksheet for " & (Company_Name) & " created" 
110
111‘Set sh name
112
113            Set sh = Sheets(Company_Name)
114
115                GoTo Step2
116        Else
117        End If
118    End If
119
120‘If tab and data exist
121
122Step2:
123
124‘Clear existing data and resize table
125
126    With Sheets(Company_Name).ListObjects(1)
127        .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.count - 1, .DataBodyRange.Columns.count).Rows.Delete
128        .DataBodyRange.ClearContents
129    End With
130
131Find first row of table (las row of sheet as data previously cleared)
132
133lrow = Sheets(Company_Name).Range("B" & Rows.count).End(xlUp).Row
134
135    With Sourcetable.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
136        With Sheets(Company_Name)
137            .Range("A" & lrow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone
138            Application.CutCopyMode = False
139        End With
140    End With
141
142End If
143
144Continue:
145‘Reset the variable sh
146
147Set sh = Nothing
148    x = x + 1
149
150‘Loop back to get a new Company's name in Employee Roster
151
152Loop While Sheets("General").Range("A" & x).Value <> ""
153
154‘At end of loop turn screen refresh etc back on
155
156    Application.DisplayAlerts = True
157    Application.ScreenUpdating = True
158    Sheets("Amalgamated Data").Select
159
160'Clear all filter from table
161
162    Sourcetable.AutoFilter.ShowAllData
163    MsgBox "All Sheets Updated"
164End Sub