Wednesday, August 8, 2018

Automatic filtering of excel data and save the filtered data in a pdf using VBA ,VBA Teacher Sourav,Kolkata 09748184075

Sub filter_pdf()

'We need to remove all filters first

Workbooks(ActiveWorkbook.Name).Activate
    Sheets("Sheet1").Activate
    Dim str3 As String



   
ActiveSheet.Cells.Select

Selection.ClearFormats

If ActiveSheet.AutoFilterMode Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
End If

'Now we need to get the data by which we are going to filter

Dim Message, Title, Default
Message = "Enter a value "    ' Set prompt.
Title = "InputBox Demo"    ' Set title.
Default = "1"    ' Set default.
' Display message, title, and default value.
str3 = InputBox(Message, Title, Default)

'We need to find the address of the range to be filtered which is expanding horizantally


    Sheets("Sheet1").Activate
ActiveSheet.Range("A1").Select
   
    Dim i As Long
    Dim count As Integer

    Dim str1 As String
    For i = 1 To 500000
    If ActiveCell.Value = "Sales" Then
    str1 = ActiveCell.Address
    Exit For
    Else
    ActiveCell.Offset(0, 1).Select
End If

   
   
   
   
   
    Next i
    MsgBox (str1)
   ActiveSheet.Range(str1).Select
    For i = 1 To 500000
    If ActiveCell.Value = "" Then
   
    Exit For
    Else
    str1 = ActiveCell.Address
   
   
    ActiveCell.Offset(1, 0).Select
End If

   
   
   
   
   
    Next i
   
 
   MsgBox (str1)
  
    Dim str2 As String
    str2 = "A1:" & str1
    MsgBox (str2)
   Selection.Clear
   ActiveSheet.Range(str2).AutoFilter Field:=1, Criteria1:=str3, Operator:=xlAnd
  
  
   'Now the filtered data is presented in the sheet.we need to convert this result into a pdf
  
   Dim customer_code As String
Dim pdffolder As FileDialog

customer_code = Range("A2").Text


Set pdffolder = Application.FileDialog(msoFileDialogFolderPicker)
pdffolder.AllowMultiSelect = False
pdffolder.Show

  
   
        Dim dir As String
        dir = pdffolder.SelectedItems(1)
   
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dir & "\" & customer_code & ".pdf", openafterpublish:=False
               
        MsgBox ("PDF Generated")
               
     
       

End Sub

No comments:

Post a Comment