GardianAngelUK
New Member
- Joined
- Mar 6, 2024
- Messages
- 1
- Office Version
- 2016
- Platform
- Windows
I am trying to set up a workbook that tracks daily workloads across 6 teams. each day has its own sheet and on each sheet, each team have their own table.
I would like a button on each sheet to transfer rows that haven't been approved or rejected (each table has a column called Approve/Reject and has 3 states, Approved, Rejected or Blank) into its counterpart table on the next day's sheet.
For ease we shall use generic naming Sheet 1, sheet 2 etc.. and table 1, table 2 etc.
So to be clear i have 7 sheets, on each sheet there is 6 tables which means first table on sheet 2 will be called table7.
Being new to VBA coding I decided to break it down into steps and the have a single macro that runs each macro one after the other so i have managed to come up with the macros towards the bottom of this question, which almost does what i need so long as each table has at least one row that hasn't been approved or rejected. Some code is copy and pasted then adapted and other is created using the recorder then adapted. so likely can be done a lot easier.
My issue is that when a table has all its rows either approved or rejected then the filter the macros put on don't work so it tries to copy over all the rows which is not what i want. I also want to only copy over a day at a time.
Plus info may have already been inserted into the next day's table which my current method overwrites so could do with sorting that too if that is possible.
Hopefully i have explained my issue as best as i can but please ask for any other info you may need so can anyone help me as I'm lost and cannot figure it out?
I would like a button on each sheet to transfer rows that haven't been approved or rejected (each table has a column called Approve/Reject and has 3 states, Approved, Rejected or Blank) into its counterpart table on the next day's sheet.
For ease we shall use generic naming Sheet 1, sheet 2 etc.. and table 1, table 2 etc.
So to be clear i have 7 sheets, on each sheet there is 6 tables which means first table on sheet 2 will be called table7.
Being new to VBA coding I decided to break it down into steps and the have a single macro that runs each macro one after the other so i have managed to come up with the macros towards the bottom of this question, which almost does what i need so long as each table has at least one row that hasn't been approved or rejected. Some code is copy and pasted then adapted and other is created using the recorder then adapted. so likely can be done a lot easier.
My issue is that when a table has all its rows either approved or rejected then the filter the macros put on don't work so it tries to copy over all the rows which is not what i want. I also want to only copy over a day at a time.
Plus info may have already been inserted into the next day's table which my current method overwrites so could do with sorting that too if that is possible.
Hopefully i have explained my issue as best as i can but please ask for any other info you may need so can anyone help me as I'm lost and cannot figure it out?
VBA Code:
Sub Sunaddrows()
'This macro adds a defined amount of rows to each table on the next days tables.
Sheets("Sheet 1").Select
Dim ws As Worksheet: Set ws = ActiveSheet
Dim i As Long, x As Long
Dim Tbl As ListObject
Dim NewRow As ListRow
i = Sheets("Hidden sheet").Range("I4").Value ' this cell is on a normally hidden sheet and relates to a cell containing formula =COUNTBLANK(Table1[Approve/Reject]) which dictates how many rows to add
Set Tbl = ws.ListObjects(1)
For x = 1 To i
Set NewRow = ws.ListObjects("Table7").ListRows.Add(AlwaysInsert:=True)
Next x
i = Sheets("Hidden sheet").Range("I5").Value
Set Tbl = ws.ListObjects(1)
For x = 1 To i
Set NewRow = ws.ListObjects("Table8").ListRows.Add(AlwaysInsert:=True)
Next x
i = Sheets("Hidden sheet").Range("I6").Value
Set Tbl = ws.ListObjects(1)
For x = 1 To i
Set NewRow = ws.ListObjects("Table9").ListRows.Add(AlwaysInsert:=True)
Next x
i = Sheets("Hidden sheet").Range("I7").Value
Set Tbl = ws.ListObjects(1)
For x = 1 To i
Set NewRow = ws.ListObjects("Table10").ListRows.Add(AlwaysInsert:=True)
Next x
i = Sheets("Hidden sheet").Range("I8").Value
Set Tbl = ws.ListObjects(1)
For x = 1 To i
Set NewRow = ws.ListObjects("Table11").ListRows.Add(AlwaysInsert:=True)
Next x
i = Sheets("Hidden sheet").Range("I9").Value
Set Tbl = ws.ListObjects(1)
For x = 1 To i
Set NewRow = ws.ListObjects("Table12").ListRows.Add(AlwaysInsert:=True)
Next x
End Sub
Sub SunfilterON()
' This macro adds filter where it hides all approved and rejected rows (well its supposed too) but i believe this is the step that needs work
Sheets("Sheet 1").Select
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4, _
Criteria1:="="
ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=4, Criteria1:= _
"="
ActiveSheet.ListObjects("Table3").Range.AutoFilter Field:=4, _
Criteria1:="="
ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=4, _
Criteria1:="="
ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=4, Criteria1 _
:="="
ActiveSheet.ListObjects("Table6").Range.AutoFilter Field:=4, _
Criteria1:="="
End Sub
Sub SunfilterOff()
'
' Turns off the above filters
'
'
Sheets("Sheet 1").Select
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4
ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=4
ActiveSheet.ListObjects("Table3").Range.AutoFilter Field:=4
ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=4
ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=4
ActiveSheet.ListObjects("Table6").Range.AutoFilter Field:=4
End Sub
Sub Suntransfer()
'
' This is the copy and paste step originally created using recorder and then adapted slightly so does have unnecessary rows but I'm scared of braking what is currently working so left it as it is.
'
'
Application.Goto Reference:="Table1"
Selection.copy
Sheets("Sheet 2").Select
Range("Table7").Select
ActiveSheet.Paste
Application.Goto Reference:="Table2"
Application.CutCopyMode = False
Selection.copy
Sheets("Sheet2").Select
Range("Table8").Select
ActiveSheet.Paste
Application.Goto Reference:="Table3"
Application.CutCopyMode = False
Selection.copy
Sheets("Sheet2").Select
Range("Table9").Select
ActiveSheet.Paste
Application.Goto Reference:="Table4"
Application.CutCopyMode = False
Selection.copy
Sheets("Sheet2").Select
Range("Table10").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Application.Goto Reference:="Table5"
Application.CutCopyMode = False
Selection.copy
Sheets("Sheet2").Select
Range("Table11").Select
ActiveSheet.Paste
Application.Goto Reference:="Table6"
Application.CutCopyMode = False
Selection.copy
Sheets("Sheet2").Select
Range("Table12").Select
ActiveSheet.Paste
End Sub
Sub TransferSuntoMon()
' The actual macro that is attached to a button on each sheet
Call Sunrows
Call SunfilterON
Call Suntransfer
Call SunfilterOff
End Sub