Skip blank from Auto Filter

[nrk]

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


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

[p45cal]

After the line For Each x In Range…
add:
If len(Application.Trim(x.value))>0 Then
then just before the line Next x
add:
End if

[nrk]

Thanks p45cal (http://www.vbaexpress.com/forum/member.php?3494-p45cal) it works perfectly:hi: