Macro to Filter/Save As Not Working

corcelle · Jun 1st 2016

Hello,

I wrote the following macro, and it worked for a while, then I had to make a tweak and it is no longer working. The goal is to hide certain rows, open that filtered view in a new workbook, and save that workbook to the user's desktop:

Code

Sub ExportMFTasks()
BeginRow = 20
    EndRow = 400
    ChkCol = 3
    
    Application.ScreenUpdating = False
    
    Cells.Select
    Selection.EntireRow.Hidden = False
    Range("A1").Select
    For RowCnt = BeginRow To EndRow
         If Cells(RowCnt, ChkCol).Value = "COE" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
         If Cells(RowCnt, ChkCol).Value = "COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "COE Delivery" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
         If Cells(RowCnt, ChkCol).Value = "COE Delivery/COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Vendor/COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
         If Cells(RowCnt, ChkCol).Value = "Vendor/COE Delivery" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "PCM" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "RIO" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Quality Manager" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Vendor/COE" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
    Next RowCnt
    
    Application.ScreenUpdating = True
    Sheets("CAMPAIGN").Select
    Sheets("CAMPAIGN").Copy
    ActiveWorkbook.SaveAs Filename:= _
    Environ$("USERPROFILE") & "\Desktop\MF Task Export.xlsx", FileFormat:=xlOpenXMLWorkbook _
    , CreateBackup:=False
    
    Cells.Select
    Selection.EntireRow.Hidden = False
    Range("A1").Select

Display More

Not sure where I went wrong -- help appreciated!
Thanks,
Corcelle

Max1616 · Jun 1st 2016

Re: Macro to Filter/Save As Not Working

What line is giving you the error? If no error what is currently happening that makes it not work?

Max1616 · Jun 1st 2016

Re: Macro to Filter/Save As Not Working

Code

Sub ExportMFTasks()
    BeginRow = 20
    EndRow = 400
    ChkCol = 3
    Dim MyWB As Workbook
    Dim NewWB As Workbook
    
    Set MyWB = ActiveWorkbook
    Application.ScreenUpdating = False
     
    Cells.Select
    Selection.EntireRow.Hidden = False
    Range("A1").Select
    For RowCnt = BeginRow To EndRow
        If Cells(RowCnt, ChkCol).Value = "COE" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "COE Delivery" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "COE Delivery/COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Vendor/COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Vendor/COE Delivery" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "PCM" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "RIO" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Quality Manager" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Vendor/COE" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
    Next RowCnt
     
    Application.ScreenUpdating = True
    
    'Adds new workbook
    Set NewWB = Workbooks.Add
    
    MyWB.Activate
    MyWB.Sheets("CAMPAIGN").Select
    MyWB.Sheets("CAMPAIGN").Cells.Copy Destination:=NewWB.Sheets(1).Cells(1, 1)


    NewWB.SaveAs Filename:= _
    Environ$("USERPROFILE") & "\Desktop\MF Task Export.xlsx", FileFormat:=xlOpenXMLWorkbook _
    , CreateBackup:=False
    
    NewWB.Close False
    
    MyWB.Activate
    Cells.Select
    Selection.EntireRow.Hidden = False
    Range("A1").Select
End Sub

Display More

I think your issue is that your code does nothing with the values that are copied. So you do all of the hiding without actually putting the new values in a new workbook.

*Edit fixed an error

corcelle · Jun 1st 2016

Re: Macro to Filter/Save As Not Working

Hi,
There is no error -- the macro executes. However, I want the new page to only show certain rows (which is why I have the Hide commands), but it is showing all of the rows.)

Max1616 · Jun 1st 2016

Re: Macro to Filter/Save As Not Working

Also you might want to consider changing your end row to be more dynamic to your dataset. I usually use something like this:

Code

endrow=cells(rows.count,1).end(xlup).row

Just a piece of friendly coding advice

I fixed an error in the code, can you try it again?

Max1616 · Jun 1st 2016

Re: Macro to Filter/Save As Not Working

Caught one more error that is not excluding the hidden cell when copying (sorry I was doing it by freehand before) I just tested this one and it works:

Code

Sub ExportMFTasks()
    BeginRow = 20
    EndRow = 400
    ChkCol = 3
    Dim MyWB As Workbook
    Dim NewWB As Workbook
    
    Set MyWB = ActiveWorkbook
    Application.ScreenUpdating = False
     
    Cells.Select
    Selection.EntireRow.Hidden = False
    Range("A1").Select
    For RowCnt = BeginRow To EndRow
        If Cells(RowCnt, ChkCol).Value = "COE" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "COE Delivery" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "COE Delivery/COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Vendor/COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Vendor/COE Delivery" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "PCM" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "RIO" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Quality Manager" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Vendor/COE" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
    Next RowCnt
     
    Application.ScreenUpdating = True
    
    'Adds new workbook
    Set NewWB = Workbooks.Add
    
    MyWB.Activate
    MyWB.Sheets("CAMPAIGN").Cells.Select
    Selection.SpecialCells(xlCellTypeVisible).Copy Destination:=NewWB.Sheets(1).Cells(1, 1)


    NewWB.SaveAs Filename:= _
    Environ$("USERPROFILE") & "\Desktop\MF Task Export.xlsx", FileFormat:=xlOpenXMLWorkbook _
    , CreateBackup:=False
    
    NewWB.Close False
    
    MyWB.Activate
    Cells.Select
    Selection.EntireRow.Hidden = False
    Range("A1").Select
End Sub

Display More

corcelle · Jun 1st 2016

Re: Macro to Filter/Save As Not Working

Thank you for your help. It is giving me an error on the following line, saying I cannot change part of a merged cell.

Selection.SpecialCells(xlCellTypeVisible).Copy Destination:=NewWB.Sheets(1).Cells(1, 1)

Max1616 · Jun 1st 2016

Re: Macro to Filter/Save As Not Working

is it possible for you to attach your sheet? Where is the merged cell in your data set?

corcelle · Jun 2nd 2016

Re: Macro to Filter/Save As Not Working

Here you go -- Thank you so much, this is frustrating me!
forum.ozgrid.com/index.php?attachment/69308/

Max1616 · Jun 2nd 2016

Re: Macro to Filter/Save As Not Working

Sorry for the delay. Try this:

Code

Sub ExportMFTasks()
    BeginRow = 35
    EndRow = 400
    ChkCol = 3
    Dim MyWB As Workbook
    Dim NewWB As Workbook
     
    Set MyWB = ActiveWorkbook
    Application.ScreenUpdating = False
     
    Cells.Select
    On Error Resume Next
    Selection.EntireRow.Hidden = False
    Range("A1").Select
    For RowCnt = BeginRow To EndRow
        If Cells(RowCnt, ChkCol).Value = "COE" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "COE Delivery" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "COE Delivery/COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Vendor/COE Strategy" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Vendor/COE Delivery" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "PCM" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "RIO" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Quality Manager" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
        If Cells(RowCnt, ChkCol).Value = "Vendor/COE" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
    Next RowCnt
     
    Application.ScreenUpdating = True
     
     'Adds new workbook
    Set NewWB = Workbooks.Add
     
    MyWB.Activate
    
    MyWB.Sheets("CAMPAIGN").Range(Rows(1), Rows(BeginRow - 1)).Copy Destination:=NewWB.Sheets(1).Cells(1, 1)
    
    MyWB.Sheets("CAMPAIGN").Range(Rows(BeginRow), Rows(EndRow)).Select
    Selection.SpecialCells(xlCellTypeVisible).Copy Destination:=NewWB.Sheets(1).Cells(BeginRow, 1)
     
    NewWB.Activate
    ActiveWindow.DisplayGridlines = False
    Cells.WrapText = False
    Columns(1).EntireColumn.AutoFit
    Range(Columns(3), Columns(11)).EntireColumn.AutoFit
    
    MyWB.Activate
     
    NewWB.SaveAs Filename:= _
    Environ$("USERPROFILE") & "\Desktop\MF Task Export.xlsx", FileFormat:=xlOpenXMLWorkbook _
    , CreateBackup:=False
     
    NewWB.Close False
     
    MyWB.Activate
    Cells.Select
    On Error Resume Next
    Selection.EntireRow.Hidden = False
    Range("A1").Select
End Sub

Display More

I adjusted some code and your begin row number.

corcelle · Jun 8th 2016

Re: Macro to Filter/Save As Not Working

Sorry it took me a while to respond to this. I replaced my code with your code above, and it created a new file called MF Tasks Export and saved it to the Desktop, but the file is blank/has no content.

Any thoughts?

Macro to Filter/Save As Not Working

Participate now!

Share