Re-arranging structure data and recalculate formulas by add new sheet

O

Omar M

Board Regular
Joined
Jan 11, 2024
Messages
66
Office Version
  1. 2019
Platform
  1. Windows
Hello,
I would arrange data again by add new sheet "Arra"
this is the original data
KshfHsab1.xls
ABCDEFGH
1
2
3
4
5ACCOUNT LIST
6
7BALANCE: CREDIT (85.00) TO:FATTUH
8
9DATEVOUCHER NOINVOICE NODESCRIBEBALANCECREDITDEBIT
102023.12.31 BALANCE DAY 2023/12/31 -41430.0000.0041,430.00
112024.01.09489RECEIVED VOUCHER-23430.00018,000.000.00
122024.01.20145PURCHASES-20180.0003,250.000.00
132024.01.30548RECEIVED VOUCHER5.00020,185.000.00
142024.04.24817SALES-26995.0000.0027,000.00
152024.04.24771RECEIVED VOUCHER5.00027,000.000.00
162024.04.29846SALES-23595.0000.0023,600.00
172024.06.02937RECEIVED VOUCHER1405.00025,000.000.00
182024.06.02996SALES-57995.0000.0059,400.00
192024.06.03939RECEIVED VOUCHER-32995.00025,000.000.00
202024.07.061008RECEIVED VOUCHER0.00032,995.000.00
212024.07.131107SALES-27000.0000.0027,000.00
222024.07.131031RECEIVED VOUCHER0.00027,000.000.00
232024.08.11970000078SALES-4150.0000.004,150.00
242024.08.15970000117SALES-8300.0000.004,150.00
252024.08.17970000121SALES-29900.0000.0021,600.00
262024.08.17910000216RECEIVED VOUCHER-29550.000350.000.00
272024.08.29910000217RECEIVED VOUCHER-9550.00020,000.000.00
282024.09.05970000273SALES-13850.0000.004,300.00
292024.09.23910000335RECEIVED VOUCHER85.00013,935.000.00
30TOTAL85.000212,715.00212,630.00
31
ACCA
Cell Formulas
RangeFormula
E12E12=E22-20180




the result
KshfHsab1.xls
ABCDEFGH
1
2
3
4
5ACCOUNT LIST
6
7BALANCE: CREDIT (85.00)
8
9DATENAMEDESCRIBEINVOICE NOVOUCHER NODEBITCREDITBALANCE
102023.12.31FATTUH BALANCE DAY 2023/12/31 41,430.000.0041430.000
112024.01.09FATTUHRECEIVED VOUCHER4890.0018,000.0023430.000
122024.01.20FATTUHPURCHASES1450.003,250.0020180.000
132024.01.30FATTUHRECEIVED VOUCHER5480.0020,185.00-5.000
142024.04.24FATTUHSALES81727,000.000.0026995.000
152024.04.24FATTUHRECEIVED VOUCHER7710.0027,000.00-5.000
162024.04.29FATTUHSALES84623,600.000.0023595.000
172024.06.02FATTUHRECEIVED VOUCHER9370.0025,000.00-1405.000
182024.06.02FATTUHSALES99659,400.000.0057995.000
192024.06.03FATTUHRECEIVED VOUCHER9390.0025,000.0032995.000
202024.07.06FATTUHRECEIVED VOUCHER10080.0032,995.000.000
212024.07.13FATTUHSALES110727,000.000.0027000.000
222024.07.13FATTUHRECEIVED VOUCHER10310.0027,000.000.000
232024.08.11FATTUHSALES9700000784,150.000.004150.000
242024.08.15FATTUHSALES9700001174,150.000.008300.000
252024.08.17FATTUHSALES97000012121,600.000.0029900.000
262024.08.17FATTUHRECEIVED VOUCHER9100002160.00350.0029550.000
272024.08.29FATTUHRECEIVED VOUCHER9100002170.0020,000.009550.000
282024.09.05FATTUHSALES9700002734,300.000.0013850.000
292024.09.23FATTUHRECEIVED VOUCHER9100003350.0013,935.00-85.000
30TOTAL212,630.00212,715.00-85.000
Arra
Cell Formulas
RangeFormula
H10,H30H10=F10-G10
H11:H29H11=H10+F11-G11
F30:G30F30=SUM(F10:F29)

without forgetting auto fill name in column B based on D7 and recalculate formulas in column BALANCE and TOTAL row , but I don't need it as in ACCA sheet..every time when run the macro should add new sheet with date today like this Arra_14-11-2024.
thanks
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
Hello @Omar M.
Try next code:
VBA Code: 
Option Explicit

Sub Re_Arranging()
    Dim i           As Long
    Dim sName       As String: sName = "Arra " & Format(Date, "dd-mm-yyyy")
    Sheets.Add(, Sheets(Sheets.Count)).Name = sName

    With ThisWorkbook.Worksheets("ACCA")
        Dim lastRow As Long: lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Dim outtxt  As String: outtxt = Trim(Replace(.Cells(7, 4).Text, "TO:", ""))
        Dim dataArr As Variant: dataArr = .Range("A9:G" & lastRow).Value

        Dim destArr As Variant
        ReDim destArr(1 To UBound(dataArr), 1 To 8)

        For i = 1 To UBound(dataArr)
            Dim destRow As Long: destRow = i + 8

            destArr(i, 1) = dataArr(i, 1)
            destArr(i, 2) = outtxt
            destArr(i, 5) = dataArr(i, 2)
            destArr(i, 4) = dataArr(i, 3)
            destArr(i, 3) = dataArr(i, 4)
            destArr(i, 8) = dataArr(i, 5)
            destArr(i, 7) = dataArr(i, 6)
            destArr(i, 6) = dataArr(i, 7)
        Next i

    End With

    With ThisWorkbook.Worksheets(sName)
        .Cells(9, 1).Resize(UBound(destArr), 8).Value = destArr

        .Cells(5, 3).Value = "ACCOUNT LIST"
        .Cells(7, 3).Value = "BALANCE: CREDIT (85.00)   "
        .Cells(9, 2).Value = "NAME"
        .Cells(30, 5).Value = "TOTAL"
        .Cells(10, 8).Formula = "=F10-G10"
        .Cells(30, 8).Formula = "=F30-G30"

        With .Range("H11:H29")
            .Formula = "=H10+F11-G11"
        End With

        With .Range("F30:G30")
            .Formula = "=SUM(F10:F29)"
        End With

        With .Range("F10:H30")
            .NumberFormat = "0.000"
        End With

        .Cells.EntireColumn.AutoFit
    End With

    Application.ScreenUpdating = True
End Sub
Maybe I misunderstood you, try it. Glad to help you. Good luck.
 
Upvote 0
it's perfect !
I need fixing somethings
1- I would make formatting and borders as I did it in OP
2- when run the macro every time in date today I would replace data for sheet in date (today)
3-sorry about error in last row should minus ,not plus as your code does it, but I need in B7 if the lastrow contains plus value like 85 then B7 =BALANCE:DEBIT 85 , If the minus value in last row -85 then will be in B7=BALANCE: CREDIT(85) , sorry I don't mentioned in OP
thanks.
 
Upvote 0
Ok, points 1 and 2 - do it, I don't mind. Point 3, as the question was asked on the screen, I did it.
 
Upvote 0
Ok, points 1 and 2 - do it, I don't mind.
Click to expand...
appreciated for that.
as the question was asked on the screen, I did it.
Click to expand...
yes but when arrange data could change from minus to plus values then should change in B7 based what I ask for point 3.
 
Upvote 0
Try
VBA Code: 
Option Explicit

Sub Re_Arranging_v2()
    Dim i           As Long
    Dim sName       As String: sName = "Arra " & Format(Date, "dd-mm-yyyy")
    Dim balanceVal  As Double

    If Evaluate("ISREF('" & sName & "'!A1)") = False Then _
            Sheets.Add(, Sheets(Sheets.Count)).Name = sName

    With ThisWorkbook.Worksheets("ACCA")
        Dim lastRow As Long: lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Dim outtxt  As String: outtxt = Trim(Replace(.Cells(7, 4).Text, "TO:", ""))
        Dim dataArr As Variant: dataArr = .Range("A9:G" & lastRow).Value

        Dim destArr As Variant
        ReDim destArr(1 To UBound(dataArr), 1 To 8)

        For i = 1 To UBound(dataArr)
            Dim destRow As Long: destRow = i + 8

            destArr(i, 1) = dataArr(i, 1)
            destArr(i, 2) = outtxt
            destArr(i, 5) = dataArr(i, 2)
            destArr(i, 4) = dataArr(i, 3)
            destArr(i, 3) = dataArr(i, 4)
            destArr(i, 8) = dataArr(i, 5)
            destArr(i, 7) = dataArr(i, 6)
            destArr(i, 6) = dataArr(i, 7)
        Next i

    End With

    With ThisWorkbook.Worksheets(sName)
        .Cells(9, 1).Resize(UBound(destArr), 8).Value = destArr

        .Cells(5, 3).Value = "ACCOUNT LIST"
        .Cells(9, 2).Value = "NAME"
        .Cells(30, 5).Value = "TOTAL"
        .Cells(10, 8).Formula = "=F10-G10"
        .Cells(30, 8).Formula = "=F30-G30"

        With .Range("H11:H29")
            .Formula = "=H10+F11-G11"
        End With

        With .Range("F30:G30")
            .Formula = "=SUM(F10:F29)"
        End With

        With .Range("F10:H30")
            .NumberFormat = "0.000"
        End With

        balanceVal = .Cells(30, 8).Value

        If balanceVal >= 0 Then
            .Cells(7, 3).Value = "BALANCE: DEBIT " & Format(balanceVal, "0.00")
        Else
            .Cells(7, 3).Value = "BALANCE: CREDIT (" & Format(Abs(balanceVal), "0.00") & ")"
        End If

        .Cells.EntireColumn.AutoFit
    End With

    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Different way.
Code: 
Sub test()
    Dim myName$, Bal#
    With Sheets("arra")
        Sheets("acca").Cells.Copy .[a1]
        .Columns("g").Copy .[h1]: myName = Split(.[d7], ":")(1): .[d7] = ""
        .Range("a" & Rows.Count).End(xlUp)(2).EntireRow.Clear
        With .[a9].CurrentRegion
            .Value = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), [{1,4,4,3,2,7,6,5}])
            .HorizontalAlignment = xlCenter: .Range("b1") = "NAME": .Borders.Weight = 2
            .Columns("a:b").Offset(1).Resize(.Rows.Count - 1) = Array(Format(Date, "yyyy,mm,dd"), myName)
            .Columns("f").Value = .Parent.Evaluate(Replace("if((#<>"""")*(isnumber(#)),abs(#),if(#<>"""",#,""""))", "#", .Columns("f").Address))
            .Range("h2").FormulaR1C1 = "=rc[-2]-rc[-1]"
            .Range("h3").Resize(.Rows.Count - 2).FormulaR1C1 = "=r[-1]c+rc[-2]-rc[-1]"
            With .Rows(.Rows.Count + 1)
                With .Range("e1")
                    .Value = "TOTAL": .Font.Bold = True
                    .Resize(, 3).Interior.Color = 15123099
                    .Resize(, 3).Borders.Weight = 2
                End With
                .Range("h1").Interior.Color = 16774348
                .Range("f1:h1").FormulaR1C1 = _
                Array("=sum(r10c:r[-1]c)", "=sum(r10c:r[-1]c)", "=rc[-2]-rc[-1]")
                Bal = .Range("h1")
            End With
            .ColumnWidth = 50: .EntireColumn.AutoFit: .Rows.AutoFit
        End With
        .[b7] = "BALANCE: " & IIf(Bal < 0, "CREDIT", IIf(Bal > 0, "DEBIT", "")) & "(" & Abs(Bal) & ")"
    End With
End Sub
 
Upvote 0
Thanks Mike,
but point 1 doesn't work , and I would show formatting in B7 like this #,##0.00.
 
Upvote 0
Thanks Fuji,
and I hope fixing about Arra sheet. there is no already existed Arra sheet ,macro should add it as I said in OP.
every time when run the macro should add new sheet with date today like this Arra_14-11-2024.
Click to expand...
and every time run the macro for same day ,then should replace data for added sheet today.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
sorting duplicates Customers names by add two formulas in last column
Replies
3
Views
374
Kerryx
K
A
  • Solved
Compare two sheets based on lastrow with highlighted cells
2 3
Replies
26
Views
341
mumps
mumps
O
  • Solved
Find and match header in different location for the column based on sheet name
Replies
8
Views
140
Omar M
O
A
  • Question Question
Populate data based on matching last part with sheet name across sheets
Replies
2
Views
111
Ali M
A
O
  • Solved
Put amount in DEBIT,CREDIT columns based on matching part of item
Replies
9
Views
206
Omran Y
O

Forum statistics

Threads
1,224,773
Messages
6,180,874
Members
453,003
Latest member
SalihZekiKoni

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top