Are you sitting comfortably, then I'll begin ... once upon a ....
Problem Overview
I have a report that uses a macro to filter data from 3 different sheets, then completes 17 sections on each of 35 identical output sheets.
When the macro is run with F8 it works fine, but when run properly it seems to duplicate some of the tables during loop 1 (i.e. output sheet 1) 12 times.
More background
This is my first ever post, please be gentle ha ha, i am putting it all out there to save time with queries back and fore, hopefully this helps.
I've used Excel for 25 years but not used VBA for 15 years and just getting back up to speed, hence there will be better ways of doing things i am sue, but for now i am focussing on finding the error.
I have a report that has a number of input sheets (Stat, Remedials, CAFM) then 35 output sheets (one for each site named 1 to 35 so i can loop the macro through).
Each of the 35 output sheets are identical (before macro population) and they have 17 section all with named ranges (e.g. Section_3_1 etc same name on each sheet as the sheet was duplicated) that need populating by the macro.
The report now has many macros (all saved under Module 2, other than an auto open macro to set protection but to allow users to group sections and for the macro to run without unprotecting eahc time) and each macro calls other macros to do various tasks.
The macro process
The general process is that the user updates the 3 input data sheets (Stat, Remedials, CAFM) then puts an x on an Instruction sheet checklist to say that part is done, as there could be multiple people populating other sections of the report too, but i am just showing the macro elements in this forum to try to keep it as simple as possible.
Once there are sufficient x's to enable a particular macro to run, the main macro will first ask the user if they wish to run the macro as it will create duplicates if run more than once.
If they say yes, it then checks if there are sufficient x's on the checklist and whether it hasn't been run before, if there are insufficient x's or it has been run before it exits with a popup box, otherwise the macro is good to run.
The macro will start a loop and use the loop number to populate sheet 1, then 2 ... to 35.
Within loop 1 it will filter the relevant data source and count the results, it will then go to Sheet 1, if the results are zero it will insert "NONE" in a cell otherwise it will insert the required number of rows, go back to the input filtered data, copy the filtered data and specific columns, then populate table 1 (Section_3_1) on sheet 1 with the specific filtered results, then move on to the next section on sheet 1.
It does a similar exercises using the 3 input data sheets, to then populate all 17 Sections on sheet 1, before in incrementing the loop to do it all again on the remainder of the 35 sheets.
As the file if quite large, with many complex formula, plus the macro process, i have set the macro to turn off auto save (which then saves the file, taking a 2 mins to save due to network location), turn off screen updated, turn off calculations and disable the status bar, so i can put a progress status in it for the user (i'll sort an onscreen progress bar another time using forms i believe).
The problem
Stepping through the macro everything runs fine.
Running the macro, all is fine for all 17 section on all 35 sheets EXCEPT:
For some reason, on sheet 1 only and in Section_3_2_N, Section_3_2_NR, Section_3_2_P and Section_3_2_M, if the results are not Zero, then it seems to paste in the data 12 times in each table.
This does not happen in these sections on all the other sheets (i.e. loop 2 to 35).
I thought it could be a variable not being set, but am sure i have set them prior to it running.
I have tried, Adding a wait timer after turning autosave off, but it didn't help.
I have not tried, getting the file save status and only processing if True, ie. once autosave has saved it, as I suspect it is a code error not a processor issue.
The Code
Brace yourself, here's some of the code for the first few sections of the report, the remaining sections are something similar.
The code has been created from recording macros, editing the code and finding solutions from others on forums, thus you may even recognise some ha ha
Here goes and please remember i consider myself to be a novice.
Problem Overview
I have a report that uses a macro to filter data from 3 different sheets, then completes 17 sections on each of 35 identical output sheets.
When the macro is run with F8 it works fine, but when run properly it seems to duplicate some of the tables during loop 1 (i.e. output sheet 1) 12 times.
More background
This is my first ever post, please be gentle ha ha, i am putting it all out there to save time with queries back and fore, hopefully this helps.
I've used Excel for 25 years but not used VBA for 15 years and just getting back up to speed, hence there will be better ways of doing things i am sue, but for now i am focussing on finding the error.
I have a report that has a number of input sheets (Stat, Remedials, CAFM) then 35 output sheets (one for each site named 1 to 35 so i can loop the macro through).
Each of the 35 output sheets are identical (before macro population) and they have 17 section all with named ranges (e.g. Section_3_1 etc same name on each sheet as the sheet was duplicated) that need populating by the macro.
The report now has many macros (all saved under Module 2, other than an auto open macro to set protection but to allow users to group sections and for the macro to run without unprotecting eahc time) and each macro calls other macros to do various tasks.
The macro process
The general process is that the user updates the 3 input data sheets (Stat, Remedials, CAFM) then puts an x on an Instruction sheet checklist to say that part is done, as there could be multiple people populating other sections of the report too, but i am just showing the macro elements in this forum to try to keep it as simple as possible.
Once there are sufficient x's to enable a particular macro to run, the main macro will first ask the user if they wish to run the macro as it will create duplicates if run more than once.
If they say yes, it then checks if there are sufficient x's on the checklist and whether it hasn't been run before, if there are insufficient x's or it has been run before it exits with a popup box, otherwise the macro is good to run.
The macro will start a loop and use the loop number to populate sheet 1, then 2 ... to 35.
Within loop 1 it will filter the relevant data source and count the results, it will then go to Sheet 1, if the results are zero it will insert "NONE" in a cell otherwise it will insert the required number of rows, go back to the input filtered data, copy the filtered data and specific columns, then populate table 1 (Section_3_1) on sheet 1 with the specific filtered results, then move on to the next section on sheet 1.
It does a similar exercises using the 3 input data sheets, to then populate all 17 Sections on sheet 1, before in incrementing the loop to do it all again on the remainder of the 35 sheets.
As the file if quite large, with many complex formula, plus the macro process, i have set the macro to turn off auto save (which then saves the file, taking a 2 mins to save due to network location), turn off screen updated, turn off calculations and disable the status bar, so i can put a progress status in it for the user (i'll sort an onscreen progress bar another time using forms i believe).
The problem
Stepping through the macro everything runs fine.
Running the macro, all is fine for all 17 section on all 35 sheets EXCEPT:
For some reason, on sheet 1 only and in Section_3_2_N, Section_3_2_NR, Section_3_2_P and Section_3_2_M, if the results are not Zero, then it seems to paste in the data 12 times in each table.
This does not happen in these sections on all the other sheets (i.e. loop 2 to 35).
I thought it could be a variable not being set, but am sure i have set them prior to it running.
I have tried, Adding a wait timer after turning autosave off, but it didn't help.
I have not tried, getting the file save status and only processing if True, ie. once autosave has saved it, as I suspect it is a code error not a processor issue.
The Code
Brace yourself, here's some of the code for the first few sections of the report, the remaining sections are something similar.
The code has been created from recording macros, editing the code and finding solutions from others on forums, thus you may even recognise some ha ha
Here goes and please remember i consider myself to be a novice.
VBA Code:
Option Explicit
Global site As Integer
Global SiteSheet As String
Global building As Variant
Global NrOfRecords As Integer
Global lastCol As Integer
Global lastRow As Long
Global rng As Range
Global Count1 As Integer
Global lr As Long
Global NextMonthFrom As Double
Global NextMonthTo As Double
Global StatCol As Integer
Global NrOfUtilities As Integer
Global Utility As Integer
Global ProgressCounter As Long
Global Check1 As String
Global Check2 As String
Global Check3 As String
Global Check4 As String
Global Check5 As String
Function Password() As String
Password = "test"
End Function
Sub ProtectSheet()
ActiveSheet.Protect Password:=Password(), UserInterFaceOnly:=True, AllowFiltering:=True 'Allow macro to edit without needing to unprotect but allow user to use autofilters
ActiveSheet.EnableOutlining = True 'Allow users to group and ungroup data while sheet is protected
End Sub
Sub ShowAllRecords()
With ActiveSheet.AutoFilter
If .FilterMode Then
.ShowAllData
End If
End With
End Sub
Sub ProtectWorkbook()
Application.ScreenUpdating = False 'stop the screen from showing what is happening to speed up the macro
Dim wSheet As Worksheet
For Each wSheet In ActiveWorkbook.Worksheets
wSheet.Activate
ProtectSheet
Next wSheet
ThisWorkbook.Protect Password:=Password(), Structure:=True, Windows:=True 'Protecting the Structure or the Windows
Sheets("Instructions").Select
Application.ScreenUpdating = True
End Sub
Sub UnprotectWorkbook()
Application.ScreenUpdating = False 'stop the screen from showing what is happening to speed up the macro
Dim wSheet As Worksheet
For Each wSheet In Worksheets
wSheet.Unprotect Password:=Password()
Next wSheet
ThisWorkbook.Unprotect Password:=Password()
Sheets("Instructions").Select
Application.ScreenUpdating = True
End Sub
Sub CountVisRows()
Set rng = ActiveSheet.AutoFilter.Range
NrOfRecords = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
End Sub
Sub DoYouWishToRunThisMacro()
Dim Answer As String
Answer = MsgBox("WARNING!" & Chr(13) & Chr(10) _
& "Running this macro will automatically populate all tables on all Sites. " & Chr(13) & Chr(10) _
& "This may take several mins to perform. " & Chr(13) & Chr(10) _
& "Excel may state NOT RESPONDING and the screen may look frozen." & Chr(13) & Chr(10) _
& "It IS OK, do NOT close the file, it IS working in the background!" & Chr(13) & Chr(10) _
& "" & Chr(13) & Chr(10) _
& "To check on progress;" & Chr(13) & Chr(10) _
& "- look at the bottom left of the screen, " & Chr(13) & Chr(10) _
& "- this will state which section it is up to, " & Chr(13) & Chr(10) _
& "- it will also show which sheet it is up to, " & Chr(13) & Chr(10) _
& "- when it has finished, you will get another pop up box. " & Chr(13) & Chr(10) _
& "" & Chr(13) & Chr(10) _
& "IMPORTANT:" & Chr(13) & Chr(10) _
& "CAFM sheet: Do not change the field names of the order. " & Chr(13) & Chr(10) _
& "CAFM sheet: the yellow formula must be as long as the data. " & Chr(13) & Chr(10) _
& "Stat sheet: Do not change the field names of the order. " & Chr(13) & Chr(10) _
& "Remedials sheet: Do not change the field names of the order. " & Chr(13) & Chr(10) _
& "If the macro has been run before it WILL create duplicate data. " & Chr(13) & Chr(10) _
& "DO NOT use the computer while the macro is running!" & Chr(13) & Chr(10) _
& "This will take several minutes to execute." & Chr(13) & Chr(10) _
& "" & Chr(13) & Chr(10) _
& "Are you sure you wish to run this macro?" _
, vbQuestion + vbYesNo, "ONLY RUN THIS MACRO ONCE")
If Answer = vbYes Then
Check1 = Range("MacroCheck1").Value 'Get the value in the cell named MacroCheck1 and assign it to variable Check1
Check2 = Range("MacroCheck2").Value 'Get the value in the cell named MacroCheck2 and assign it to variable Check2
If Check1 = "N" Then
MsgBox "UNABLE TO RUN THE MACRO!" & Chr(13) & Chr(10) _
& "Please ensure the data on the CAFM, Stat and Remedials sheets have been updated and an x is " _
& "inserted against the Task on the Checklist on the Instructions Sheet before running the Macro."
ElseIf Check2 = "Y" Then
MsgBox "UNABLE TO RUN THE MACRO!" & Chr(13) & Chr(10) _
& "The macro has been run before, if you were to run it again it would create duplicates."
Else
PopulateAllSites
Sheets("Instructions").Select
Range("MacroCheck2").Value = "Y"
End If
ElseIf Answer = vbNo Then
MsgBox "You have chosen to cancel the macro, no data has changed.", vbInformation, "Exit Macro"
End If
End Sub
Sub PopulateAllSites()
' ============ SPEED UP THE MACRO ==========
If ActiveWorkbook.AutoSaveOn = True Then ActiveWorkbook.AutoSaveOn = False 'if autosave is enabled then turn it off
Application.Calculation = xlManual 'turn off auto-calc to speed up the macro
Application.ScreenUpdating = False 'stop the screen from showing what is happening to speed up the macro
' ============= set variables =============
site = 1 ' set a variable called site as a number to represent the site sheet number to populate
NrOfRecords = 0
ProgressCounter = 0
lastCol = 0
lastRow = 0
Count1 = 0
lr = 0
For site = 1 To 35 ' create a loop to repeat 35 times, once for each population of each site sheet
[B][COLOR=rgb(226, 80, 65)]' ===== start =======================================================================================[/COLOR][/B]
Sheets("" & site).Select ' GO TO SHEET 1 etc
building = Range("L3").Value ' GET BUILDING NAME AND SET AS VARIABLE
NextMonthFrom = Range("NextMonthStart").Value 'Get the value in the cell named NextMonthStart and assign it to variable NextMonthFrom
NextMonthTo = Range("NextMonthEnd").Value 'Get the value in the cell named NextMonthEnd and assign it to variable NextMonthTo
StatCol = Range("StatColNr").Value 'Get the value in the cell named StatColNr and assign it to variable StatCol
' RUN EACH MACRO THAT FILTERS THE CAFM DATA AND COPIES THEN PASTES IT INTO THE CURRENT SITE SHEET
Application.StatusBar = "Processing section 1 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_3_1
ProgressCounter = Round(((((site - 1) * 17) + 1) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 2 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_3_2_N
ProgressCounter = Round(((((site - 1) * 17) + 2) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 3 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_3_2_NR
ProgressCounter = Round(((((site - 1) * 17) + 3) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 4 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_3_2_P
ProgressCounter = Round(((((site - 1) * 17) + 4) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 5 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_3_2_M
ProgressCounter = Round(((((site - 1) * 17) + 5) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 6 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_3_2_R
ProgressCounter = Round(((((site - 1) * 17) + 6) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 7 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_4_2_1_CL
ProgressCounter = Round(((((site - 1) * 17) + 7) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 8 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_4_2_1_NCL
ProgressCounter = Round(((((site - 1) * 17) + 8) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 9 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_4_2_2_CL
ProgressCounter = Round(((((site - 1) * 17) + 9) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 10 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_4_2_2_NCL
ProgressCounter = Round(((((site - 1) * 17) + 10) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 11 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_4_3_1_CL
ProgressCounter = Round(((((site - 1) * 17) + 11) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 12 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_4_3_1_NCL
ProgressCounter = Round(((((site - 1) * 17) + 12) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 13 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_4_4
ProgressCounter = Round(((((site - 1) * 17) + 13) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 14 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_5_1
ProgressCounter = Round(((((site - 1) * 17) + 14) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 15 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_7_2
ProgressCounter = Round(((((site - 1) * 17) + 15) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 16 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_8_1
ProgressCounter = Round(((((site - 1) * 17) + 16) / (17 * 35)) * 100, 0)
Application.StatusBar = "Processing section 17 of 17 on site " & site & " of 35 (" & ProgressCounter & "% Complete)"
Section_8_2
ProgressCounter = Round(((((site - 1) * 17) + 17) / (17 * 35)) * 100, 0)
' ===== end ============================================================================
Next site
site = site - 1
Sheets("Instructions").Select
' Turn Auto-Calc, Screen updates and Auto-Save back on
Application.Calculation = xlAutomatic
On Error GoTo ErrorHandler 'if the next line developes an error because autosave can't be turned on then jump to ErrorHandler:
ActiveWorkbook.AutoSaveOn = True
ErrorHandler:
Application.ScreenUpdating = True
Application.StatusBar = False ' reset the status bar
ProtectWorkbook 'Call the sub to reprotect the Worksheets and workbook
MsgBox "all " & site & " sites complete!" ' message box to say all done
End Sub
Sub Section_3_1()
Sheets("CAFM").Select
ShowAllRecords
' IDENTIFY THEN SELECT ALL DATA READY TO FILTER
Range("a1").CurrentRegion.Select
lastCol = Range("a1").End(xlToRight).Column
lastRow = Cells(Rows.Count, lastCol).End(xlUp).Row
' FILTER DATA
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=15, Criteria1:="Priority 8" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=10, Criteria1:="" & building '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=35, Criteria1:="1" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' COUNT NR OF FILTERED VISIBLE ROWS
CountVisRows
' IF NR OF FILTERED RECORDS IS ZERO PUT NONE IN THE COMMENTS BOX
' OTHERWISE COPY THEN PASTE IT INTO THE RELEVANT SECTION
If NrOfRecords = 0 Then
Sheets("" & site).Select
Application.Goto Reference:="TaskID_3_1" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Offset(0, 7).Range("A1:C1").Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Value = "NONE"
Else
' insert enough rows based on the value of NrOfRecords
' in the table ready to copy and paste filtered data
Sheets("" & site).Select
Application.Goto Reference:="TaskID_3_1" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' insert additional rows in the table required
Count1 = 1
For Count1 = 1 To NrOfRecords - 1 Step 1
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Next
' then copy the columns required from the filtered data
Sheets("CAFM").Select ' GO TO CAFM SHEET
' FIND LAST ROW NUMBER OF THE FILTERED DATA
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
' SELECT FILTERED DATA AND COPY
ActiveSheet.Range("A2:D" & lr _
& ", AC2:AE" & lr _
).Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' Range("A" & lr).Activate 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Application.CutCopyMode = False
Selection.Copy
' then paste the selected filtered column data into the table required
Sheets("" & site).Select
Application.Goto Reference:="TaskID_3_1" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
Sub Section_3_2_N()
Sheets("Stat").Select
ShowAllRecords
' IDENTIFY THEN SELECT ALL DATA READY TO FILTER
Range("a1").CurrentRegion.Select
lastCol = Range("a1").End(xlToRight).Column
lastRow = Cells(Rows.Count, lastCol).End(xlUp).Row
' FILTER DATA
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=3, Criteria1:="S" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=StatCol, Criteria1:="N" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' COUNT NR OF FILTERED VISIBLE ROWS
CountVisRows
' IF NR OF FILTERED RECORDS IS ZERO PUT NONE IN THE COMMENTS BOX
' OTHERWISE COPY THEN PASTE IT INTO THE RELEVANT SECTION
If NrOfRecords = 0 Then
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_N" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Offset(0, 6).Range("A1:D1").Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Value = "NONE"
Else
' insert enough rows based on the value of NrOfRecords
' in the table ready to copy and paste filtered data
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_N" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' insert additional rows in the table required
Count1 = 1
For Count1 = 1 To NrOfRecords - 1 Step 1
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Next
' then copy the columns required from the filtered data
Sheets("Stat").Select ' GO TO Stat SHEET
' FIND LAST ROW NUMBER OF THE FILTERED DATA
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
' SELECT FILTERED DATA AND COPY
ActiveSheet.Range("A2:B" & lr _
& ", D2:D" & lr _
).Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' Range("A" & lr).Activate 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Application.CutCopyMode = False
Selection.Copy
' then paste the selected filtered column data into the table required
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_N" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
Sub Section_3_2_NR()
Sheets("Stat").Select
ShowAllRecords
' IDENTIFY THEN SELECT ALL DATA READY TO FILTER
Range("a1").CurrentRegion.Select
lastCol = Range("a1").End(xlToRight).Column
lastRow = Cells(Rows.Count, lastCol).End(xlUp).Row
' FILTER DATA
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=3, Criteria1:="S" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=StatCol, Criteria1:="NR" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' COUNT NR OF FILTERED VISIBLE ROWS
CountVisRows
' IF NR OF FILTERED RECORDS IS ZERO PUT NONE IN THE COMMENTS BOX
' OTHERWISE COPY THEN PASTE IT INTO THE RELEVANT SECTION
If NrOfRecords = 0 Then
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_NR" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Offset(0, 6).Range("A1:D1").Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Value = "NONE"
Else
' insert enough rows based on the value of NrOfRecords
' in the table ready to copy and paste filtered data
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_NR" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' insert additional rows in the table required
Count1 = 1
For Count1 = 1 To NrOfRecords - 1 Step 1
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Next
' then copy the columns required from the filtered data
Sheets("Stat").Select ' GO TO Stat SHEET
' FIND LAST ROW NUMBER OF THE FILTERED DATA
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
' SELECT FILTERED DATA AND COPY
ActiveSheet.Range("A2:B" & lr _
& ", D2:D" & lr _
).Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Application.CutCopyMode = False
Selection.Copy
' then paste the selected filtered column data into the table required
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_NR" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
Sub Section_3_2_P()
Sheets("Stat").Select
ShowAllRecords
' IDENTIFY THEN SELECT ALL DATA READY TO FILTER
Range("a1").CurrentRegion.Select
lastCol = Range("a1").End(xlToRight).Column
lastRow = Cells(Rows.Count, lastCol).End(xlUp).Row
' FILTER DATA
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=3, Criteria1:="S" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=StatCol, Criteria1:="P" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' COUNT NR OF FILTERED VISIBLE ROWS
CountVisRows
' IF NR OF FILTERED RECORDS IS ZERO PUT NONE IN THE COMMENTS BOX
' OTHERWISE COPY THEN PASTE IT INTO THE RELEVANT SECTION
If NrOfRecords = 0 Then
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_P" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Offset(0, 6).Range("A1:D1").Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Value = "NONE"
Else
' insert enough rows based on the value of NrOfRecords
' in the table ready to copy and paste filtered data
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_P" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' insert additional rows in the table required
Count1 = 1
For Count1 = 1 To NrOfRecords - 1 Step 1
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Next
' then copy the columns required from the filtered data
Sheets("Stat").Select ' GO TO Stat SHEET
' FIND LAST ROW NUMBER OF THE FILTERED DATA
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
' SELECT FILTERED DATA AND COPY
ActiveSheet.Range("A2:B" & lr _
& ", D2:D" & lr _
).Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Application.CutCopyMode = False
Selection.Copy
' then paste the selected filtered column data into the table required
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_P" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
Sub Section_3_2_M()
Sheets("Stat").Select
ShowAllRecords
' IDENTIFY THEN SELECT ALL DATA READY TO FILTER
Range("a1").CurrentRegion.Select
lastCol = Range("a1").End(xlToRight).Column
lastRow = Cells(Rows.Count, lastCol).End(xlUp).Row
' FILTER DATA
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=3, Criteria1:="S" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=StatCol, Criteria1:="M" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' COUNT NR OF FILTERED VISIBLE ROWS
CountVisRows
' IF NR OF FILTERED RECORDS IS ZERO PUT NONE IN THE COMMENTS BOX
' OTHERWISE COPY THEN PASTE IT INTO THE RELEVANT SECTION
If NrOfRecords = 0 Then
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_M" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Offset(0, 6).Range("A1:D1").Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Value = "NONE"
Else
' insert enough rows based on the value of NrOfRecords
' in the table ready to copy and paste filtered data
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_M" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' insert additional rows in the table required
Count1 = 1
For Count1 = 1 To NrOfRecords - 1 Step 1
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Next
' then copy the columns required from the filtered data
Sheets("Stat").Select ' GO TO Stat SHEET
' FIND LAST ROW NUMBER OF THE FILTERED DATA
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
' SELECT FILTERED DATA AND COPY
ActiveSheet.Range("A2:B" & lr _
& ", D2:D" & lr _
).Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Application.CutCopyMode = False
Selection.Copy
' then paste the selected filtered column data into the table required
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_M" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
Sub Section_3_2_R()
Sheets("Remedials").Select
ShowAllRecords
' IDENTIFY THEN SELECT ALL DATA READY TO FILTER
Range("a1").CurrentRegion.Select
lastCol = Range("a1").End(xlToRight).Column
lastRow = Cells(Rows.Count, lastCol).End(xlUp).Row
' FILTER DATA
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=3, Criteria1:="S" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=StatCol, Criteria1:=">0" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' COUNT NR OF FILTERED VISIBLE ROWS
CountVisRows
' IF NR OF FILTERED RECORDS IS ZERO PUT NONE IN THE COMMENTS BOX
' OTHERWISE COPY THEN PASTE IT INTO THE RELEVANT SECTION
If NrOfRecords = 0 Then
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_R" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Offset(0, 7).Range("A1:C1").Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Value = "NONE"
Else
' insert enough rows based on the value of NrOfRecords
' in the table ready to copy and paste filtered data
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_R" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' insert additional rows in the table required
Count1 = 1
For Count1 = 1 To NrOfRecords - 1 Step 1
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Next
' then copy the columns required from the filtered data
Sheets("Remedials").Select ' GO TO Remedials SHEET
' FIND LAST ROW NUMBER OF THE FILTERED DATA
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
' SELECT FILTERED DATA AND COPY
ActiveSheet.Range("A2:B" & lr _
& ", D2:D" & lr _
).Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Application.CutCopyMode = False
Selection.Copy
' then paste the selected filtered column data into the table required
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_R" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Remedials").Select ' GO TO Remedials SHEET
' SELECT FILTERED DATA AND COPY
ActiveSheet.Range(Cells(2, StatCol).Address & ":" & Cells(lr, StatCol).Address).Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Application.CutCopyMode = False
Selection.Copy
' then paste the selected filtered column data into the table required
Sheets("" & site).Select
Application.Goto Reference:="Tab_3_2_R" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Offset(0, 6).Range("A1:A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
End Sub
Sub Section_4_2_1_CL()
Sheets("CAFM").Select
ShowAllRecords
' IDENTIFY THEN SELECT ALL DATA READY TO FILTER
Range("a1").CurrentRegion.Select
lastCol = Range("a1").End(xlToRight).Column
lastRow = Cells(Rows.Count, lastCol).End(xlUp).Row
' FILTER DATA
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=36, Criteria1:="SBCO", Operator:=xlOr, Criteria2:="SDCO" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Range("a1:" & Cells(lastRow, lastCol).Address).AutoFilter Field:=10, Criteria1:="" & building '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' COUNT NR OF FILTERED VISIBLE ROWS
CountVisRows
' IF NR OF FILTERED RECORDS IS ZERO PUT NONE IN THE COMMENTS BOX
' OTHERWISE COPY THEN PASTE IT INTO THE RELEVANT SECTION
If NrOfRecords = 0 Then
Sheets("" & site).Select
Application.Goto Reference:="TaskID_4_2_1_CL" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Offset(0, 9).Range("A1:A1").Select '<<<A1:A1 is if a single cell if merged then A1:C1 would be 3 cells merged<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ActiveCell.Value = "NONE"
Else
' insert enough rows based on the value of NrOfRecords
' in the table ready to copy and paste filtered data
Sheets("" & site).Select
Application.Goto Reference:="TaskID_4_2_1_CL" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' insert additional rows in the table required
Count1 = 1
For Count1 = 1 To NrOfRecords - 1 Step 1
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Next
' then copy the columns required from the filtered data
Sheets("CAFM").Select ' GO TO CAFM SHEET
' FIND LAST ROW NUMBER OF THE FILTERED DATA
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
' SELECT FILTERED DATA AND COPY
ActiveSheet.Range("A2:C" & lr _
& ", K2:L" & lr _
& ", P2:P" & lr _
& ", AC2:AE" & lr _
).Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Application.CutCopyMode = False
Selection.Copy
' then paste the selected filtered column data into the table required
Sheets("" & site).Select
Application.Goto Reference:="TaskID_4_2_1_CL" '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
