Hi, I am using the below code for creating a worksheet of filter data. The code is created by Kjbox. Here is Link. Now I need some modification of the same code.
I tried but it gives me an error as I am not very good at VBA coding.
The request is:
1. When the file created upon command button a summation of the "Amount" Hdrs to the last row,
2. "TRA_Date" will be the today date,
3. "Register Note" comes from the e2 cell value,
4. "Narration" comes from the f2 cell value.
5. "Address" as a fixed text.
6. TSL Hdrs cell Text "C" but the last cell of the last row will be "D"
Hope someone supports me and will be highly appreciated. Wish Kjbox will be again.
Thanks and Best regards.
The code is here:
Code
Sub Button2_Click()
Dim x, y, Hdrs, wbk As Excel.Workbook, i As Long, ii As Long, sNm As String
Const sPath As String = "E:\Upload Folder\"
Hdrs = Array("SL", "Invoice", "Name", "Address", "TSL", "TRA_Date", _
"Amount", "Amount in Word", "Register Note", "Narration")
sNm = [j2]
' Load all data in Bill sheet into array x
x = Sheet22.[b4].CurrentRegion
' Size and load array y with only visible Invoice Numbers
ReDim y(1 To 10, 1 To 1)
For i = 2 To UBound(x, 1)
If Not Sheets("All Data").Rows(i + 3).Hidden Then
ii = ii + 1
ReDim Preserve y(1 To 10, 1 To ii)
y(1, ii) = ii
y(2, ii) = "'" & x(i, 4): y(3, ii) = "'" & x(i, 7): y(4, ii) = "'" & x(i, 8)
y(5, ii) = "'" & x(i, 5): y(6, ii) = "'" & x(i, 3): y(7, ii) = "'" & x(i, 6)
y(8, ii) = "'" & x(i, 9): y(9, ii) = "'" & x(i, 12): y(10, ii) = "'" & x(i, 10)
End If
Next
' 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 = sNm
' Write contents of arrays Hdrs & y to the new worksheet
.Cells(1, 1).Resize(, 10) = Hdrs
.Cells(2, 1).Resize(UBound(y, 2), 10) = Application.Transpose(y)
' Set the formatting for the new sheet (-4108 is the enumeration for xlCenter)
With .Cells(1).CurrentRegion
.VerticalAlignment = -4108
.Columns(1).HorizontalAlignment = -4108
.Columns(2).Resize(, 2).HorizontalAlignment = -4131
.Columns(4).Resize(, 8).HorizontalAlignment = -4108
.Columns(2).Resize.VerticalAlignment = -4108
.Rows(1).HorizontalAlignment = -4108
.Columns(1).ColumnWidth = 10
.Columns(2).ColumnWidth = 9
.Columns(3).ColumnWidth = 22
.Columns(4).ColumnWidth = 10
.Columns(5).ColumnWidth = 10
.Columns(7).ColumnWidth = 10
.Columns(8).ColumnWidth = 60
.Columns(9).ColumnWidth = 15
End With
' Freeze the header Row
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = 1
' Save the new workbook with required name
.Parent.SaveAs sPath & sName & "Doc_Marge" & Format(Now, "dd_mm_yyyy hh_nn") & ".xls", 52
End With
End Sub