VBA Macro for adding up digits based on criteria

[Nitin Suntwal]

Hi There,

I am trying to update column F (Code), I want it to update automatically with VBA.

I have a worksheet where I have to update the code manually in column F (Code) based on Column A (Drawers) & E (Drawer Levels). The column E contains numbers from 2 to 5 the numbers are assigned some values given below:

Drawer Levels Assigned Value
2 10000
3 1000
4 100
5 1

Below are the column A and its description

Drawers Father Account Key
Asset 100000
Liability 200000
Equity 300000
Revenues 400000
Expenses 500000

In column E the same numbers are repeated many times. Below is the logic

For Assets
First time if column A (Drawers) is Asset & column E (Drawer Levels) is 2 then the F (Code) column should be 100000. Second time if if column A (Drawers) is Asset & column E (Drawer Levels) is 2 then the F (Code) column should be 100000+10000.


For Liability
First time if column A (Drawers) is Liability & column E (Drawer Levels) is 2 then the F (Code) column should be 200000. Second time if if column A (Drawers) is Liability & column E (Drawer Levels) is 2 then the F (Code) column should be 200000+10000.

For Equity
First time if column A (Drawers) is Equity & column E (Drawer Levels) is 2 then the F (Code) column should be 300000. Second time if if column A (Drawers) is Equity & column E (Drawer Levels) is 2 then the F (Code) column should be 300000+10000.
and so on.

I have tried all the ways you can change the sheet as per your convenient. The VBA macro is in module 5.

Attached is the worksheet for your reference.

Thanks,
Nitin Suntwal.

 

[Marc L]

Hi !

An easy way :​

Sub Demo1()
            VL = [{0,10000,1000,100,1}]
    With Sheet6.Cells(1).CurrentRegion.Rows
            VA = Application.Index(.Value, Evaluate("ROW(1:" & .Count & ")"), [{1,5}])
            ReDim F&(2 To .Count, 0)
        For R& = 2 To .Count
            If VA(R, 1) = VA(R - 1, 1) Then C& = C& + VL(VA(R, 2)) Else D& = D& + 100000: C = D
                F(R, 0) = C
        Next
            .Range("F2").Resize(.Count - 1).Value = F
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Nitin Suntwal]

Thanks Marc.

Today I have started working on your code, its going well but the actual values which i am looking for is different. below is the data values. If the drawer level value is again 2 then the first DL 2 which is 100000 should be added by 10000 which will be 110000 if again repeated by 2 then 110000 + 10000 the same will for DL 3.

Drawer Levels Code
2 100000
3 101000
4 101100
4 101200
4 101300
4 101400
4 101500
4 101600
3 102000
4 102100
4 102200
4 102300
4 102400
3 103000
4 103100
4 103200
2 110000
3 111000

Let me know if I can help you more to understand my query.

 

[jindon]

See if this works,

Sub test()
    Dim a, i As Long, e, w
    With Sheets("COA Data").Cells(1).CurrentRegion
        a = Application.Index(.Value, .Parent.Evaluate("row(1:" & .Rows.Count & ")"), [{6,1,5}])
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For Each e In Array(Array("Asset", 100000), Array("Liability", 200000), _
                Array("Equity", 300000), Array("Revenues", 400000), Array("Expenses", 500000))
                .Item(e(0)) = Array(e(1), 0)
            Next
            For i = 2 To UBound(a, 1)
                w = .Item(a(i, 2)): w(1) = w(1) + 1
                If w(1) = 1 Then
                    a(i, 1) = w(0)
                Else
                    If a(i, 3) <> 5 Then w(0) = Application.RoundDown(w(0), a(i, 3) - 6)
                    a(i, 1) = Application.RoundDown(w(0), IIf(a(i, 3) <> 5, a(i, 3) * (4 - a(i, 3)), 1)) _
                        + 10 ^ (6 - IIf(a(i, 3) = 5, 6, a(i, 3)))
                    w(0) = a(i, 1)
                End If
                .Item(a(i, 2)) = w
            Next
        End With
        .Columns("f").Value = a
    End With
End Sub

 

[Nitin Suntwal]

Perfect Thanks J.