· 6 years ago · Jul 02, 2019, 08:22 PM
1Option Explicit
2SUB UPDATE_BACKUP_SHEETSFIXED()
3 'This Sub does the following:
4 ' Filter Amalgamated Data by companyName from table list on General Sheet
5 ' Then
6 ' 1. If no data:
7 ' a. Check if a company Tab exists
8 ' i. If not, move on to next company
9 ' ii. If so:
10 ' 1. If there is existing data clear and move to next company
11 ' 2. If no existing data move to next company
12 ' 2. Check if Company tab exists
13 ' a. If tab does not exist, create:
14 ' i. Tab
15 ' ii. Balance Download Record
16 ' iii. Overview Record
17 ' b. If tab does exist (or has just been created above)
18 ' i. If there is data, Clear existing
19 ' ii. Copy transactions from Amalgamated Data Filter
20
21 Dim amalgamatedDateSheet As Worksheet
22 Set amalgamatedDateSheet = Sheets("Total Data")
23
24 Dim sourceTable As ListObject
25 Set sourceTable = amalgamatedDateSheet.ListObjects("TableFullData")
26
27 Dim generalSheet As Worksheet
28 Set generalSheet = Sheets("General")
29
30 Dim templateSheet As Worksheet
31 Set templateSheet = Sheets("Template")
32
33 Dim balanceDownloadSheet As Worksheet
34 Set balanceDownloadSheet = Sheets("Balance Download")
35
36 Dim overviewSheet As Worksheet
37 Set overviewSheet = Sheets("Overview")
38
39 Dim X As Long
40 X = 4
41
42 Application.DisplayAlerts = False
43 Application.ScreenUpdating = False
44
45
46 'Get the Company name from the Company Tab
47
48 Do
49 Dim companyName As String
50 With generalSheet
51 companyName = .Range("A" & X).Value
52 End With
53
54 'Clear all filter from table
55
56 sourceTable.AutoFilter.ShowAllData
57
58 'Filter by Company Name
59
60 sourceTable.DataBodyRange.AutoFilter Field:=2, Criteria1:="=" & companyName
61
62 'Check if transactions exist
63
64 Dim firstColumnContainsNoVisibleCells As Boolean
65 Dim companySheet As Worksheet
66 On Error Resume Next
67 Set companySheet = Sheets(companyName)
68 On Error Resume Next
69 firstColumnContainsNoVisibleCells = sourceTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count <= 1
70
71 On Error GoTo 0
72 If firstColumnContainsNoVisibleCells Then
73
74 'If no transactions
75
76 If Not companySheet Is Nothing = True Then
77
78 'If no transactions but Tab exists for Company
79
80 Dim targetTable As ListObject
81 Set targetTable = companySheet.ListObjects(1)
82 Dim firstTargetColumnContainsVisibleCells As Boolean
83 On Error Resume Next
84 firstTargetColumnContainsVisibleCells = targetTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count > 1
85
86 'If Data present, clear it
87
88 If firstTargetColumnContainsVisibleCells Then
89 With targetTable
90 .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.count - 1, .DataBodyRange.Columns.count).Rows.Delete
91 .DataBodyRange.ClearContents
92 End With
93 End If
94
95 Call CheckRecordsPresent(balanceDownloadSheet, companyName, overviewSheet)
96
97 'If no data present move to next company
98
99 End If
100
101 Else
102 'If transactions exist
103
104 If Not companySheet Is Nothing = False Then
105
106 'If tab for Company does not exist
107
108 If templateSheet.Visible = xlSheetVeryHidden Then templateSheet.Visible = xlSheetVisible
109
110 'Create and rename sheet highlight it yellow
111 templateSheet.Copy After:=Sheets(5)
112 ActiveSheet.Range("A20").ListObject.Name = "Table" & (companyName)
113 ActiveSheet.Name = (companyName)
114 With ActiveSheet.Tab
115 .Color = XlRgbColor.rgbYellow
116 .TintAndShade = 0
117 End With
118 Set companySheet = Sheets(companyName)
119
120 'Hide template
121
122 templateSheet.Visible = xlSheetVeryHidden
123
124 'Confirmation Message
125
126 MsgBox "Worksheet for " & (companyName) & " created"
127
128
129 End If
130 'If tab and data exist
131 Call CheckRecordsPresent(balanceDownloadSheet, companyName, overviewSheet)
132
133 'Clear existing data and resize table
134
135 Set targetTable = companySheet.ListObjects(1)
136
137 On Error Resume Next
138 firstTargetColumnContainsVisibleCells = targetTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count > 1
139
140 If firstTargetColumnContainsVisibleCells Then
141
142 With targetTable
143 .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.count - 1, .DataBodyRange.Columns.count).Rows.Delete
144 .DataBodyRange.ClearContents
145 End With
146
147 End If
148
149 'Find first row of table (last row of sheet as data previously cleared)
150
151 Dim lastTargetRow As Long
152
153 lastTargetRow = companySheet.Range("B" & Rows.count).End(xlUp).Row
154
155 With sourceTable.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
156 With companySheet
157 .ListObjects(1).AutoFilter.ShowAllData
158 .Range("A" & lastTargetRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone
159 Application.CutCopyMode = False
160 End With
161 End With
162 End If
163
164 'Loop back to get a new Company's name in Company Table
165
166 Set companySheet = Nothing
167 X = X + 1
168
169 'Loop back to get a new Company's name in Employee Roster
170
171 Loop While generalSheet.Range("A" & X).Value <> vbNullString
172
173 'At end of loop turn screen refresh etc back on
174
175 Application.DisplayAlerts = True
176 Application.ScreenUpdating = True
177
178 amalgamatedDateSheet.Select
179
180 'Clear all filter from table
181
182 sourceTable.AutoFilter.ShowAllData
183 MsgBox "All Sheets Updated"
184End Sub
185
186Private Sub CheckRecordsPresent(ByVal balanceDownloadSheet As Worksheet, ByVal companyName As String, ByVal overviewSheet As Worksheet)
187
188 'Check Balance Download Records - create if there isn't one
189
190 Dim lastBalanceRow As Long
191 lastBalanceRow = balanceDownloadSheet.Range("a" & Rows.count).End(xlUp).Row
192 Dim rangeBalanceDownloadFound As Range
193 Set rangeBalanceDownloadFound = balanceDownloadSheet.Range(balanceDownloadSheet.Range("A4"), balanceDownloadSheet.Range("A" & lastBalanceRow)).Find(companyName)
194
195 If rangeBalanceDownloadFound Is Nothing Then
196 With balanceDownloadSheet
197 .ListObjects(1).ListRows.Add
198 .Rows(lRow).Copy
199 .Range("A" & lastBalanceRow + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone
200 Application.CutCopyMode = False
201 .Range("a" & lRow + 1).Value = companyName
202 End With
203 End If
204
205 'Check if front page record exists
206
207 Dim lastOverviewRow As Long
208 lastOverviewRow = overviewSheet.Range("a" & Rows.count).End(xlUp).Row
209 Dim rangeOverviewFound As Range
210 Set rangeOverviewFound = overviewSheet.Range(overviewSheet.Range("A6"), overviewSheet.Range("A" & lastOverviewRow)).Find(companyName)
211
212 If rangeOverviewFound Is Nothing Then
213
214 With overviewSheet
215 .Range("A53:E53").Copy
216 .Range("A53:E53").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
217 .Range("A53").Value = companyName
218 End With
219 End If
220End Sub