Skip blank from Auto Filter
when i am runing this code works fine but finally it end with error due to copy & paste blank details to sheet.
how to skip blank value (x) from Advance filter
please help to fix this issue ....:dunno
Code:
Option ExplicitFunction GetWorksheet(shtName As String) As Worksheet
On Error Resume Next
Set GetWorksheet = Worksheets(shtName)
End Function
Sub filter()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String
Dim lastr As String
Dim newbook As Workbook
'specify sheet name in which the data is stored
sht = "DATA Sheet"
'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:H" & last)
Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True
For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=1, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy
Sheets("Format").Activate
ActiveSheet.Cells(5, 1).Select
ActiveSheet.Paste
lastr = Sheets("Format").Cells(Rows.Count, "A").End(xlUp).Row
Rows(lastr).EntireRow.Delete
ActiveSheet.Cells(lastr, 1).Select
ActiveCell = "Closing Balance " & Cells(3, 1)
ActiveCell.Font.Bold = True
ActiveSheet.Cells(lastr, 5).Select
ActiveCell.Value = Application.Sum(Range(Cells(6, 5), Cells(lastr, 5)))
ActiveCell.NumberFormat = "#,##0.00"
ActiveCell.Font.Bold = True
Workbooks("Copy of Staement Template - CLS.xlsm").Worksheets("Format").Copy 'Before:=newbook.Sheets(1)
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & _
ActiveSheet.Range("A1") & "_Outstanding Statement_" & ActiveSheet.Range("A3") & "_" & ActiveSheet.Range("A4") & ".xlsx"
ActiveWorkbook.Close SaveChanges:=True
Workbooks("Copy of Staement Template - CLS.xlsm").Worksheets("Format").Activate
Range(Cells(6, 1), Cells(lastr, 8)).ClearContents
End With
Next x
'Turn off filter
Sheets(sht).AutoFilterMode = False
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
