Generate and save as excel from another filter data sheet

[mamun_ges]

I have a datasheet. From this datasheet, the excel file generated specific data. I have been using the below code to generate the excel file.

But it generates the file with all data either is filtered or not. I want, it uses only the visible data to generate the excel. Or the header"invoice" column.
Hope someone helps me to solve the problem.

[LIST=1]
[*]Option Explicit
[*]Sub NewWorkbook()
[*]Dim x, y, Hdrs, wbk As Excel.Workbook, i As Long, dNum As Double, d As Double
[*]Const sPath As String = "E:\Upload Folder\"
[*]Hdrs = Array("Status", "Date", "SL", "Number", "Invoice_Number")
[*] 
[*]x = Sheets("Bill").[a2].CurrentRegion.Columns(2)
[*] 
[*]ReDim y(1 To UBound(x, 1) - 1, 1 To 5)
[*] 
[*]' Get the "Number" from cell D1
[*]dNum = [d1]
[*] 
[*]' Create a new workbook with one sheet
[*]Set wbk = Workbooks.Add(1)
[*] 
[*]Application.ScreenUpdating = 0
[*] 
[*]

[*]With wbk.Sheets(1)
[*].Name = "CB Upload"
[*] 
[*]For i = 1 To UBound(y, 1)
[*]If i < UBound(y, 1) Then
[*]y(i, 1) = "Credit"
[*]y(i, 2) = Date
[*]y(i, 3) = i 
[*]y(i, 4) = dNum 
[*]d = d + y(i, 4) 
[*]y(i, 5) = x(i + 2, 1)
[*]Else
[*]y(i, 1) = "Debit"
[*]y(i, 2) = Date
[*]y(i, 3) = i
[*]y(i, 4) = d 
[*]End If
[*]Next
[*] 
[*].Cells(1, 1).Resize(, 5) = Hdrs
[*].Cells(2, 1).Resize(UBound(y, 1), 5) = y
[*] 
[*]' Set the formatting for the new sheet (-4108 is the enumeration for xlCenter)
[*]With .Cells(1).CurrentRegion
[*].Columns(4).HorizontalAlignment = -4108
[*].Columns(5).HorizontalAlignment = -4108
[*].Rows(1).HorizontalAlignment = -4108
[*].Columns(4).ColumnWidth = 10
[*].Columns(5).ColumnWidth = 16
[*]End With
[*] 
[*]' Freeze the header Row
[*]ActiveWindow.SplitRow = 1
[*]ActiveWindow.FreezePanes = 1
[*] 
[*]' Save
[*].Parent.SaveAs sPath & "Bill_" & Format(Now, "dd_mm_yyyy hh_nn") & ".xlsx", 51
[*]End With
[*] 
[*]End Sub
[*]Sub a()
[*]For i = 1 To UBound(y, 1)
[*]y(i, 1) = i: y(i, 2) = Date
[*]If i < UBound(y, 1) Then
[*]y(i, 3) = CLng(x(i + 2, 1))
[*]y(i, 4) = "Credit": y(i, 5) = dNum
[*]d = d + y(i, 5)
[*]Else
[*]y(i, 4) = "Debit": y(i, 5) = d
[*]End If
[*]Next
[*]End Sub

[/LIST]

 

[JEC]

Since specialcells(12) ignores filtered areas, you could use the method below:
This checks if the row has height

PS: You never use indents? Makes code so much easier to read

Sub JEC()
  ar = Sheets(1).Cells(1).CurrentRegion
  ReDim a(UBound(ar))
 
   For i = 2 To UBound(ar)
     If Rows(i).RowHeight Then
        a(x) = ar(i, 1)
        x = x + 1
     End If
   Next
End Sub

 

[mamun_ges]

Thanks for your response.
The below code is not working.
For better understanding code is given below.

Option Explicit

Sub NewWorkbook()
    Dim x, y, Hdrs, wbk As Excel.Workbook, i As Long, dNum As Double, d As Double
    Const sPath As String = "E:\Upload Folder\"

' Change this to suit your actual headers
    Hdrs = Array("Status", "Date", "SL", "Number", "Invoice_Number")
   
' Load all data in Bill sheet B column into array x
    x = Sheets("Bill").[a2].CurrentRegion.Columns(2)
   
' Redimension array y to suit size of array x
    ReDim y(1 To UBound(x, 1) - 1, 1 To 5)
   
' Get the "Number" from cell D1
    dNum = [d1]
   
' Create a new workbook with one sheet
    Set wbk = Workbooks.Add(1)
   
    Application.ScreenUpdating = 0
   
' Name the new workbook sheet and add the data to it
    With wbk.Sheets(1)
        .Name = "CB Upload"
       
    ' loop through array y and add relevant data, the last row is different from all the rest
        For i = 1 To UBound(y, 1)
            If i < UBound(y, 1) Then
                y(i, 1) = "Credit"
                y(i, 2) = Date
                y(i, 3) = i 'This is the SL it increments by 1 for each iteration of the loop
                y(i, 4) = dNum  ' This is the "Number"
                d = d + y(i, 4) ' This keeps a running total of the "Number"
                y(i, 5) = x(i + 2, 1) ' This gets the invoice number from array x
            Else
                y(i, 1) = "Debit"
                y(i, 2) = Date
                y(i, 3) = i
                y(i, 4) = d 'Here the total of all "Numbers" is added
            End If
        Next
   
    ' Write contents of arrays Hdrs & y to the new worksheet
        .Cells(1, 1).Resize(, 5) = Hdrs
        .Cells(2, 1).Resize(UBound(y, 1), 5) = y
       
    ' Set the formatting for the new sheet (-4108 is the enumeration for xlCenter)
        With .Cells(1).CurrentRegion
            .Columns(4).HorizontalAlignment = -4108
            .Columns(5).HorizontalAlignment = -4108
            .Rows(1).HorizontalAlignment = -4108
            .Columns(4).ColumnWidth = 10
            .Columns(5).ColumnWidth = 16
        End With
       
    ' Freeze the header Row
        ActiveWindow.SplitRow = 1
        ActiveWindow.FreezePanes = 1
   
    ' Save the new workbook with required name
        .Parent.SaveAs sPath & "Bill_" & Format(Now, "dd_mm_yyyy hh_nn") & ".xlsx", 51
    End With
   
End Sub

 

[JEC]

Try using my suggestion. The loop and writing to sheet part is going te be something like this.

I see you already used "x". You might change some variables

x = 1
  For i = 1 To UBound(y, 1)
     If i < UBound(y, 1) And Rows(i).RowHeight Then
        y(x+1, 1) = "Credit"
        y(x+1, 2) = Date
        y(x+1, 3) = i
        y(x+1, 4) = dNum
        d = d + y(i, 4)
        y(x+1, 5) = x(i + 2, 1)
        x = x + 1
     Else
        y(x+1, 1) = "Debit"
        y(x+1, 2) = Date
        y(x+1, 3) = i
        y(x+1, 4) = d
        x = x + 1
     End If
  Next
      
  .Cells(1, 1).Resize(, 5) = Hdrs
  .Cells(2, 1).Resize(x, 5) = y

 

[mamun_ges]

Run-Time error 13
Type mismatch

Debug "y(x + 1, 5) = x(i + 2, 1)"

 

[mamun_ges]

Hi,
It says "Run-Time error 13"
"Type mismatch"

Debug "y(x + 1, 5) = x(i + 2, 1)"

Any suggestion.

 

[JEC]

Hard to say without your file but you have to built in the rowheight check like my first post.

You could try:
y(x + 1, 5) = x(x + 2, 1)

 

[mamun_ges]

Hi,
How to upload the excel file here.

 

[mamun_ges]

So, there is no hope.