Iron Man
Iron Man

Reputation: 849

Code not working correctly

I have 4 subs that run consecutively. The first sub has Calls for the other three. There are two issues I am experiencing.

  1. The 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.
  2. The 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

Answers (1)

OldUgly
OldUgly

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

Related Questions