Reputation: 849
I have 4 subs that run consecutively. The first sub has Call
s for the other three. There are two issues I am experiencing.
Copy_To_Template
sub completes all parts except, when I go
into the workbook the data is getting copied to, the WGM worksheet
is empty. Data was successfully copied to the other worksheets
correctly.Filter_AGD
sub is not removing rows at all. I will note that I am not sure if the Filter_WGM
sub is working as there is no data in the worksheet. The Filter_SWGM
is working as intended.Below are all 4 sets of code:
Sub Copy_To_Template()
'
' The following is a list of the Source Workbooks and Worksheets
Dim PRM1 As Workbook ' source workbook 1 contains current list of unassigned Problem Tasks
Set PRM1 = Workbooks("BCRS-PTASKS Unassigned.csv")
Dim PRM2 As Workbook ' source WorkBook 2 contains all assignment group information
Set PRM2 = Workbooks("Problem WGM & WGL xref with description.xls")
Dim PTASKS_Unassigned As Worksheet ' source WorkSheet
Set PTASKS_Unassigned = PRM1.Sheets("BCRS-PTASKS Unassigned")
Dim MANs As Worksheet
Set MANs = PRM2.Sheets("Page 1")
' The following is a list of all the Destination workbooks and worksheets
Dim PTASK_Template As Workbook ' destination WorkBook
Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
Dim PTASK As Worksheet
Set PTASK = PTASK_Template.Sheets("BCRS Unassigned Tasks")
Dim WGMd As Worksheet
Set WGMd = PTASK_Template.Sheets("WGM")
Dim SWGMd As Worksheet
Set SWGMd = PTASK_Template.Sheets("SWGM")
Dim AGDd As Worksheet
Set AGDd = PTASK_Template.Sheets("AGD")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Copy Unassigned Tasks
Dim LRUPT As Long
LRUPT = PTASKS_Unassigned.Range("A" & Rows.Count).End(xlUp).Row
Dim UPTRow As Long
UPTRow = PTASK.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
PTASKS_Unassigned.Range("A2:F" & LRUPT).Copy PTASK.Range("A" & UPTRow)
PTASK.Range("A:A,B:B,C:C,D:D,E:E,F:F").Columns.AutoFit
PTASK.Cells.WrapText = False
' Copy to WGM
Dim LRWGM As Long
LRWGM = MANs.Range("A" & MANs.Rows.Count).End(xlUp).Row
Dim WGMRow As Long
WGMRow = WGMd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
MANs.Range("A2:E" & LRWGM).Copy WGMd.Range("A" & WGMRow)
WGMd.Range("A:A,B:B,C:C,D:D,E:E").Columns.AutoFit
WGMd.Cells.WrapText = False
' Copy to SWGM
Dim LRSWGM As Long
LRSWGM = MANs.Range("A" & MANs.Rows.Count).End(xlUp).Row
Dim SWGMRow As Long
SWGMRow = SWGMd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
MANs.Range("A2:E" & LRSWGM).Copy SWGMd.Range("A" & SWGMRow)
SWGMd.Range("A:A,B:B,C:C,D:D,E:E").Columns.AutoFit
SWGMd.Cells.WrapText = False
' Copy to AGD
Dim LRAGD As Long
LRAGD = MANs.Range("A" & MANs.Rows.Count).End(xlUp).Row
Dim AGDRow As Long
AGDRow = AGDd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
MANs.Range("A2:E" & LRAGD).Copy AGDd.Range("A" & AGDRow)
AGDd.Range("A:A,B:B,C:C,D:D,E:E").Columns.AutoFit
AGDd.Cells.WrapText = False
Dim WB1 As Workbook
Set WB1 = Workbooks("BCRS-PTASKS Unassigned.csv")
Dim WB2 As Workbook
Set WB2 = Workbooks("Problem WGM & WGL xref with description.xls")
WB1.Close False
WB2.Close False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Call Filter_WGM
Call Filter_SWGM
Call Filter_AGD
End Sub
Sub Filter_WGM()
'
Dim PTASK_Template As Workbook
Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
Dim WGMd As Worksheet
Set WGMd = PTASK_Template.Sheets("WGM")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With WGMd
Dim LRMf As Long
For LRMf = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
If .Cells(LRMf, 3).Value <> "WorkGroup Manager" Then
.Rows(LRMf).Delete
End If
Next LRMf
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Filter_SWGM()
'
Dim PTASK_Template As Workbook
Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
Dim SWGMd As Worksheet
Set SWGMd = PTASK_Template.Sheets("SWGM")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With SWGMd
Dim LRSf As Long
For LRSf = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
If .Cells(LRSf, 3).Value <> "Secondary WorkGroup Manager" Then
.Rows(LRSf).Delete
End If
Next LRSf
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Filter_AGD()
'
Dim PTASK_Template As Workbook
Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
Dim AGDd As Worksheet
Set AGDd = PTASK_Template.Sheets("WGM")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With AGDd
Dim LRDf As Long
For LRDf = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
If .Cells(LRDf, 3).Value <> "Director / DL" Then
.Rows(LRDf).Delete
End If
Next LRDf
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Upvotes: 0
Views: 98
Reputation: 2119
I wouldn't have found this if not for the debugging outlined in your last comment. So kudo's to all of the commenters for getting us to this point.
Your Filter_AGD
sub is pointed at WGM
worksheet, and wiping out the data there ...
Sub Filter_AGD()
'
Dim PTASK_Template As Workbook
Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
Dim AGDd As Worksheet
Set AGDd = PTASK_Template.Sheets("WGM")
Should be ...
Sub Filter_AGD()
'
Dim PTASK_Template As Workbook
Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
Dim AGDd As Worksheet
Set AGDd = PTASK_Template.Sheets("AGD")
Upvotes: 2