Consulting

Results 1 to 3 of 3

Thread: Skip blank from Auto Filter

  1. #1
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location

    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 ....

    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

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,874
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location
    Thanks p45cal it works perfectly

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •