Dear Kjbox,
I am stuck, Your sample file works so fine. but in my worksheet, It is not working.
Here I attaching my file for your kind consideration. File Here Modified by Me.xlsm
Hope you help me. Please
Dear Kjbox,
I am stuck, Your sample file works so fine. but in my worksheet, It is not working.
Here I attaching my file for your kind consideration. File Here Modified by Me.xlsm
Hope you help me. Please
The values you enter in the Hdrs array do not match the Headers for the Result you require.
Please attach another sample workbook that shows actual headers used and add a second sheet that shows the desired output of the macro.
Thanks, KjBox,
I hereby attached two files.
1. Main Worksheet Modified by Me.xlsm or Source File.
2. Desired Output File TRADoc_Marge26_08_2021 08_23.xls.
Thanks in Advance.
Dear KjBox,
Waiting for your kind help.
Please.....
Try changing the code to this
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
Display More
Thank is a very small word to describe my appreciation to you.
You're welcome
Dear Kjbox,
Hope you are well in health. I need some changes to the below code (Marked blue) that you created for me.
I need a summation of the "Amount" to the last row,
"TRA_Date" will be the today date,
"Register Note" comes from the e2 cell value,
"Narration" comes from the f2 cell value.
"Address" as a fixed text.
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
Display More
Hope you help me as you help me before.
Thanks and Advance.
Dear Kjbox,
Hope you are well in health and also help me to overcome the above problem.
With best regards.
You have previously said this was solved. You will probably get a faster response if you start a new question explaining fully what you want to do. Add a link to this question.
Don’t have an account yet? Register yourself now and be a part of our community!