Filter and Create a New File

[luckee]

Hi,

I have the below updated with the help of another user. After pressing the button on Sheet2, Sheet1 filters and deletes rows based on the conditions. I want it to create a new separate file saved in the same folder with the same button. So summary the output after pressing button on Sheet2 would be:

-Sheet1 will filter and delete rows
-Separate file saved in the same folder with the filtered Sheet1
-Popup message to say "New File Created"

Sub RowFilter()
Dim N As Long, i As Long
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Sheet1")

N = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row

For i = N To 1 Step -1
If ws.Cells(i, "C") = "IP" Or ws.Cells(i, "H") = "0" And ws.Cells(i, "AK") = "0" Then
ws.Cells(i, "H").EntireRow.Delete
End If
Next i

End Sub

Thank you.

 

[breynolds0431]

Give this a try:

Sub RowFilter()
Dim N As Long, i As Long
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Sheet1")

N = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row

For i = N To 1 Step -1
    If ws.Cells(i, "C") = "IP" Or ws.Cells(i, "H") = "0" And ws.Cells(i, "AK") = "0" Then
        ws.Cells(i, "H").EntireRow.Delete
    End If
Next i

'Obtains the path of ThisWorkbook
Dim fPath As String, folder As String
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
folder = fso.GetAbsolutePathName(ThisWorkbook.Name)
fPath = fso.GetParentFolderName(folder)

'Declares the new file's name (adjust as needed)
Dim fName As String: fName = "newbook " & Format(Now, "YYYYMMDD HHMM") & ".xlsm"

'Use this option to create a copy and save it without closing original
ThisWorkbook.SaveCopyAs Filename:=fPath & "/" & fName

'Use this option to work with the newly created file
'ThisWorkbook.SaveAs Filename:=fPath & "/" & fName

'Verify file saved correctly and return applicable message
Dim strFileExists As String: strFileExists = Dir(fPath & "/" & fName)
    
    If strFileExists = "" Then
        MsgBox "The file could not be saved.", vbCritical, "Unable to Save"
    Else
        MsgBox "New File Created", vbInformation, "Save Success"
    End If

End Sub

 

[kevin9999]

You're very nearly there. Try this:

Sub RowFilter_V2()
    'Your existing code
    Dim N As Long, i As Long
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    N = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row
    
    For i = N To 1 Step -1
        If ws.Cells(i, "C") = "IP" Or ws.Cells(i, "H") = "0" And ws.Cells(i, "AK") = "0" Then
            ws.Cells(i, "H").EntireRow.Delete
        End If
    Next i
    
    'Add this bit
    ws.Copy
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    Application.DisplayAlerts = False
    wb.SaveAs ThisWorkbook.Path & "\Your New Filename" & ".xlsm", 52
    Application.DisplayAlerts = True
    MsgBox "New File Created"
    
End Sub

 

[Alex Blakenburg]

Not answering the question but just curious. I always struggle with using And and Or without using brackets.
Does your if statement actually do what you are intending ?

Book1
	A	B	C	D	E	F	G	H	I																											AJ	AK
1			Col C					Col H																													Col AK
2			IP					0																													0
3			IP					1																													0
4			IP					0																													1
5			IP					1																													1
6								0																													0
7	Not Deleted --->							1																													0
8								0																													1
9	Not Deleted --->							1																													1
Sheet1

 

[kevin9999]

Not answering the question but just curious. I always struggle with using And and Or without using brackets.
Does your if statement actually do what you are intending ?

Book1
	A	B	C	D	E	F	G	H	I																											AJ	AK
1			Col C					Col H																													Col AK
2			IP					0																													0
3			IP					1																													0
4			IP					0																													1
5			IP					1																													1
6								0																													0
7	Not Deleted --->							1																													0
8								0																													1
9	Not Deleted --->							1																													1
Sheet1

My initial thoughts as well Alex. I have assumed the existing logic is giving the OP the result they were after - and just added the file save bit. Not the logic I would have used either (i.e. without the brackets).

 

[luckee]

this worked thank you!

 

[luckee]

You're very nearly there. Try this:

Sub RowFilter_V2()
    'Your existing code
    Dim N As Long, i As Long
    Dim ws As Worksheet
   
    Set ws = ThisWorkbook.Worksheets("Sheet1")
   
    N = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row
   
    For i = N To 1 Step -1
        If ws.Cells(i, "C") = "IP" Or ws.Cells(i, "H") = "0" And ws.Cells(i, "AK") = "0" Then
            ws.Cells(i, "H").EntireRow.Delete
        End If
    Next i
   
    'Add this bit
    ws.Copy
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    Application.DisplayAlerts = False
    wb.SaveAs ThisWorkbook.Path & "\Your New Filename" & ".xlsm", 52
    Application.DisplayAlerts = True
    MsgBox "New File Created"
   
End Sub

thank worked, thank you!

 

[luckee]

My initial thoughts as well Alex. I have assumed the existing logic is giving the OP the result they were after - and just added the file save bit. Not the logic I would have used either (i.e. without the brackets).

It looked like it did what I wanted, on the one file I tried it on but I still need to test it on some other ones.

 

[kevin9999]

this worked thank you!

Glad we could help, and thanks for the feedback.