Multidimensional Array - Upper and Lower bound

[Shiro26]

Hi,

I am not sure if I am doing this right but here is the thing:
> I have a list of transaction ID-ed from 1 to 30
> Each of the transaciton is a type P, D, G respectively for Purchased, Debited and Gifted
> P and G are credit transactions
> When the type is D, the oldest credited transaction is the first used (First in First out)
> I need to know at any time, what is the balance as of gifts and as of purchases

To do so, I built an array for purchase and an array for gifts.
I try to redim each of those array everytime but I am not sure whether I am doing it the right way. Problem 1

Problem 2, when a D is encountered because I need to compare the lower bound of the array P and the array G to know which of the balance P or G I am going to substract the amount encountered => I do not manage to take the lower bound of my arrray

Problem 3, once I have "used" the oldest transaction from P or G, I would like to get rid of the line in the array in order to save the memory and ease the research of the lowerbound... but unless I use a temporary array, I am not sure whether this would be the best method...

I hope that somebody will find an interest in helping me going through that.

Thank you very much in advance.

Kind Regards,

Shiro


When I run the code at the bottom of the message on the table below, I populate Bal P, Bal G but I do not manage the part where I redim the arrays

To do so, I have created the table below:

ID	Amount	Type	Bal P	Bal G	Lbound G	Lbound P
1	10	P
2	10	G
3	60	D
4	40	G
5	10	D
6	60	P
7	40	P
8	40	D
9	10	G
10	60	P
11	10	D
12	20	G
13	100	G
14	60	D
15	10	P
16	40	D
17	20	P
18	100	D
19	100	P
20	100	D
21	10	G
22	100	P
23	20	D
24	60	P
25	100	D
26	10	P
27	20	P
28	20	D
29	20	G
30	100	D

<tbody>
</tbody>

Sub balance()
Dim VARvaloldestP As Integer
Dim VARvaloldestG As Integer
Dim VARvalREST As Integer
Dim VARvalcurrD As Integer
Dim VARbalP As Integer
Dim VARbalG As Integer

Dim VARarraydateP As Variant
Dim VARarraydateG As Variant

Dim x As Integer


Dim wbk As Workbook
Dim wsRD As Worksheet

Set wbk = ThisWorkbook
Set wsRD = wbk.Sheets("RD")

'Initialisation
'at R0:
    VARvaloldestP = 0   'to store the oldest amount corresponding to P
    VARvaloldestG = 0   'to store the oldest amount corresponding to G
    VARvalREST = 0      'to keep looping until the rest is 0 or negative
    VARvalcurrD = 0     'to store the current line value of the debit
    VARbalP = 0         'to store the balance of P point at anytime
    VARbalG = 0         'to store the balance of G poinr at anytime
    
    Prow = 1
    Grow = 1
    
    ReDim VARarraydateP(Prow, 2) 'starting with one available spot
    ReDim VARarraydateG(Grow, 2) 'starting with one available spot
    
    
    'Table length
    x = wsRD.Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Rows.Count
    
    
    
    
For eachLineCheck = 1 To x

    
    
'at R1:
    If Cells(1 + eachLineCheck, 3).Value = "P" Then                 'If R1C3 = "P" Then
        VARbalP = VARbalP + Cells(1 + eachLineCheck, 2)             'increase the balance of purchased points ==>  balP = balP + R1C2
        
        
        Prow = Prow + 1
        ReDim VARarraydateP(Prow, 2)                                     '> resize by 1 VARarraydateP(1+1:2), hence VARarraydateP=(2:1)
        VARarraydateP(Prow, 1) = Cells(1 + eachLineCheck, 1).Value       '> add the date in RxC3 @ VARarraydateP(1:1)        'here there is one P
        VARarraydateP(Prow, 2) = Cells(1 + eachLineCheck, 2).Value       '> add the amount in RxC2 @ VARarraydateP(1:2)
         
        'checking by printing a table on the right
        Cells(1 + Prow, 10).Value = VARarraydateP(Prow, 1)
        Cells(1 + Prow, 11).Value = VARarraydateP(Prow, 2)
        
        
        
        'Purchased point Balance
        Cells(1 + eachLineCheck, 4).FormulaR1C1 = VARbalP
        Cells(1 + eachLineCheck, 5) = VARbalG
    Cells(1 + eachLineCheck, 6).Value = Application.Min(VARarraydateG)
    Cells(1 + eachLineCheck, 7).Value = Application.Min(VARarraydateP)
    Cells(1 + eachLineCheck, 8).Value = LBound(VARarraydateP, 1)
    MsgBox VARarraydateP(Prow, 2)
       
       
        '> here add in the array P of cumulative values the date
        '> VARcountvalinarraydateP count the number of line in VARarraydateP
        
        
        
        
        
        
        
    ElseIf Cells(1 + eachLineCheck, 3).Value = "G" Then                 'If R1C3 = "G" Then
        VARbalG = VARbalG + Cells(1 + eachLineCheck, 2)                 'increase the balance of gifted points ==>  balG = balG + R1C2


        Grow = Grow + 1
        ReDim VARarraydateG(Grow, 2)                                     '> resize by 1 VARarraydateG(1+1:2), hence VARarraydateG=(2:1)
        VARarraydateG(Grow, 1) = Cells(1 + eachLineCheck, 1).Value       '> add the date in RxC3 @ VARarraydateG(1:1)        'here there is one G
        VARarraydateG(Grow, 2) = Cells(1 + eachLineCheck, 2).Value       '> add the amount in RxC2 @ VARarraydateG(1:2)
         
        'checking by printing a table on the right
        Cells(1 + Grow, 20).Value = VARarraydateG(Grow, 1)
        Cells(1 + Grow, 21).Value = VARarraydateG(Grow, 2)
    
        'Gifted point Balance
        Cells(1 + eachLineCheck, 5).FormulaR1C1 = VARbalG
        Cells(1 + eachLineCheck, 4) = VARbalP
    Cells(1 + eachLineCheck, 6).Value = Application.Min(VARarraydateG)
    Cells(1 + eachLineCheck, 7).Value = Application.Min(VARarraydateP)
    Cells(1 + eachLineCheck, 8).Value = LBound(VARarraydateG, 2)
    
    End If

Next eachLineCheck

'    ElseIf Cells(1 + x, 3) = "D" Then                       'If R1C3 = "D" Then
'
'
'        While VARvalREST <> 0                           '                WHILE >>>> while my VARvalREST is not equal to 0"       ' need to check the actual line amount compared with the oldest usable wallet point amount
'                'check is the oldest point is a P or a G
'
'
'                If LBound(VARarraydateP, 2) < LBound(VARarraydateG, 2) Then
'                    VARvalcurrD = R1C2.Value
'                    VARvaloldestP = Lbound VARarraydate(col2)
'                    if VARvalcurrD < VARvaloldestP
'                    balP = balP + R1C2
'                    rerange VARarraydateP range from (1:1) to (1:1) ' 2 lines and swip down to resize little by little  // i can also use a counting number to swip down the camera rather than rewriting
'
'
'
'                elseif Lbound arraydateG < Lbound arraydateP then
'                    balP = balP + R1C2
'                    redim arraydateP range from (1:1) to (0:1)
'
'
'        End If
'    End If
'
'    Print bal of P VARbalP in R1C4
'    Print bal of G VARbalG in R1C5
'
'
'
'
'From x = 1 to N
'    at Rx:
'        If RxC3 = "P" Then
'            'increase the balance of purchased points
'            balP = balP + RxC2
'            Print balP in RxC4
'            Print balG in RxC5
'
'            'here add in the array P of cumulative values the date
'            VARcountvalinarraydateP                                     'count the number of line in VARarraydateP
'            resize by 1 VARarraydateP(1+1:2), hence VARarraydateP=(2:2) 'resize expanding the array by one to enable a spot
'            add the date in RxC3 @ VARarraydateP(1:1)       'here there is one P
'            add the amount in RxC2 @ VARarraydateP(1:2)
'
'
'            If RxC3 = "G" Then
'                'increase the balance of gifted points
'                balG = balG + RxC2
'
'                'here add in the array P of cumulative values the date
'                VARcountvalinarraydateG                                 'count the number of line in VARarraydateG
'                resize by 1 VARarraydateG(1+1:2), hence VARarraydateP=(2:1) 'resize expanding the array by one to enable a spot
'                add the date in RxC3 @ VARarraydateG(1:1)       'here there is one G
'                add the amount in RxC2 @ VARarraydateG(1:2)
'
'                If RxC3 = "D" Then
'                    VARvalcurrD = RxC2.Value
'
'                    WHILE >>>> while my VARvalREST is not equal to 0"       ' need to check the actual line amount compared with the oldest usable wallet point amount
'
'                    'check is the oldest point is a P or a G
'                    if  Lbound VARarraydateP(col1) < Lbound VARarraydateG(col1) then
'                        VARvaloldestP = Lbound VARarraydate(col2)
'
'                        if  VARvalcurrD < VARvaloldestP
'                            balP = balP + RxC2
'                            redim/rerange VARarraydateP range from (1:1) to (1:1) ' 2 lines and swip down to resize little by little    // i can also use a counting number to swip down the camera rather than rewriting
'
'                        elseif  VARvalcurrD > VARvaloldestP
'                                balP = 0
'                                VARvalREST = -(balP + RxC2)
'                                redim/rerange VARarraydateP range from (1:1) to (1:1) ' 2 lines and swip down to resize little by little    // i can also use a counting number to swip down the camera rather than rewriting
'                        End If
'
'
'
'
'
'
'
'                    elseif Lbound arraydateG < Lbound arraydateP then
'                        balP = balP + R1C2
'                        redim arraydateP range from (1:1) to (0:1)
'
'
'                    End If
'                End If
'            End If
'Next I
'        Print bal of P VARbalP in R1C4
'        Print bal of G VARbalG in R1C5



End Sub

 

[CalcSux78]

Not sure if I totally follow your code, but I think this will get you close. I took the first 5 columns of data and loaded it to an array. I then loop through the array calculating what the proper balance would be for the 4th and fifth column of the array. When complete, send the data back to the worksheet.

Let me know if this helps.

Option Explicit

Sub Balance()
Dim rng As Range
Dim MyArr As Variant
Dim R As Long
Dim i As Long
Dim wsRD As Worksheet
Dim VARbalP As Integer
Dim VARbalG As Integer


Set wsRD = ThisWorkbook.Sheets("RD")


Set rng = Range(wsRD.Cells(2, 1), wsRD.Cells(2, 1).End(xlDown).Offset(, 4))
MyArr = WorksheetFunction.Transpose(rng)


'Arrays read data as Arr(Column, Row)
i = LBound(MyArr, 2)
VARbalP = 0
VARbalG = 0


For R = LBound(MyArr, 2) To UBound(MyArr, 2)
    Select Case MyArr(3, R)
        Case "P"
            VARbalP = VARbalP + MyArr(2, R)
        Case "G"
            VARbalG = VARbalG + MyArr(2, R)
        Case "D"
            'identify data type of earliest un-used record in array (i)
            If MyArr(3, i) = "D" Then   '
                Do
                    i = i + 1
                Loop Until Not MyArr(3, i) = "D"
            End If
            If MyArr(3, i) = "P" Then
                VARbalP = VARbalP - MyArr(2, R)
                i = i + 1
            ElseIf MyArr(3, i) = "G" Then
                VARbalG = VARbalG - MyArr(2, R)
                i = i + 1
            End If
    End Select
    MyArr(4, R) = VARbalP
    MyArr(5, R) = VARbalG
Next R


'send array back to worksheet range
rng = WorksheetFunction.Transpose(MyArr)


End Sub

This yields:

Excel 2010
	A	B	C	D	E
1	ID	Amount	Type	Bal P	Bal G
2	1	10	P	10	0
3	2	10	G	10	10
4	3	60	D	-50	10
5	4	40	G	-50	50
6	5	10	D	-50	40
7	6	60	P	10	40
8	7	40	P	50	40
9	8	40	D	50	0
10	9	10	G	50	10
11	10	60	P	110	10
12	11	10	D	100	10
13	12	20	G	100	30
14	13	100	G	100	130
15	14	60	D	40	130
16	15	10	P	50	130
17	16	40	D	50	90
18	17	20	P	70	90
19	18	100	D	-30	90
20	19	100	P	70	90
21	20	100	D	70	-10
22	21	10	G	70	0
23	22	100	P	170	0
24	23	20	D	170	-20
25	24	60	P	230	-20
26	25	100	D	130	-20
27	26	10	P	140	-20
28	27	20	P	160	-20
29	28	20	D	140	-20
30	29	20	G	140	0
31	30	100	D	40	0
RD

 

[Shiro26]

Hello,

Thank you very much for your reply.
This is very close to what I am looking for to obtain.

Second, I need to apologize because I realized that I had put more code than I should have which may have confused the people...

So first of all I paste below the proper original code I was willing to put:

 Dim VARvaloldestP As Integer, VARvaloldestG As Integer
Dim VARvalREST As Integer, VARvalcurrD As Integer
Dim VARbalP As Integer, VARbalG As Integer
Dim VARarraydateP As Variant, VARarraydateG As Variant
Dim x As Integer
Dim wbk As Workbook, wsRD As Worksheet
 
Set wbk = ThisWorkbook
Set wsRD = wbk.Sheets("RD")

'Initialisation
'at R0:
    VARvaloldestP = 0   'to store the oldest amount corresponding to P
    VARvaloldestG = 0   'to store the oldest amount corresponding to G
    VARvalREST = 0      'to keep looping until the rest is 0 or negative
    VARvalcurrD = 0     'to store the current line value of the debit
    VARbalP = 0         'to store the balance of P point at anytime
    VARbalG = 0         'to store the balance of G poinr at anytime
    
    Prow = 0
    Grow = 0
    
    ReDim VARarraydateP(Prow, 1) 'starting with one available spot
    ReDim VARarraydateG(Grow, 1) 'starting with one available spot
    
    
    'Table length
    x = wsRD.Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Rows.Count
    
    
    For eachlinecheck = 1 To x
    
        
        If Cells(1 + eachlinecheck, 3).Value = "P" Then                         'If R1C3 = "P" Then
            VARbalP = VARbalP + Cells(1 + eachlinecheck, 2).Value               'increase the balance of purchased points ==>  balP = balP + R1C2
            
            
            Prow = Prow + 1
            ReDim VARarraydateP(Prow, 1)                                        '> resize by 1 VARarraydateP(1+1:2), hence VARarraydateP=(2:1)
            VARarraydateP(Prow - 1, 0) = Cells(1 + eachlinecheck, 1).Value      '> add the date in RxC3 @ VARarraydateP(1:1)        'here there is one P
            VARarraydateP(Prow - 1, 1) = Cells(1 + eachlinecheck, 2).Value      '> add the amount in RxC2 @ VARarraydateP(1:2)
             
            'CHECKINGPURPOSE: printing a table on the right
            Cells(Prow, 10).Value = VARarraydateP(Prow - 1, 0)
            Cells(Prow, 11).Value = VARarraydateP(Prow - 1, 1)
            
            'Purchased point Balance
            Cells(1 + eachlinecheck, 4).FormulaR1C1 = VARbalP
            Cells(1 + eachlinecheck, 5) = VARbalG
           
           
            '> here add in the array P of cumulative values the date
            '> VARcountvalinarraydateP count the number of line in VARarraydateP
            
            
        ElseIf Cells(1 + eachlinecheck, 3).Value = "G" Then                      'If R1C3 = "G" Then
            VARbalG = VARbalG + Cells(1 + eachlinecheck, 2).Value                'increase the balance of gifted points ==>  balG = balG + R1C2
    
            Grow = Grow + 1
            ReDim VARarraydateG(Grow, 1)                                         '> resize by 1 VARarraydateG(1+1:2), hence VARarraydateG=(2:1)
            VARarraydateG(Grow - 1, 0) = Cells(1 + eachlinecheck, 1).Value       '> add the date in RxC3 @ VARarraydateG(1:1)        'here there is one G
            VARarraydateG(Grow - 1, 1) = Cells(1 + eachlinecheck, 2).Value       '> add the amount in RxC2 @ VARarraydateG(1:2)
             
            'CHECKINGPURPOSE: printing a table on the right
            Cells(Grow, 20).Value = VARarraydateG(Grow - 1, 0)
            Cells(Grow, 21).Value = VARarraydateG(Grow - 1, 1)
        
            'Gifted point Balance
            Cells(1 + eachlinecheck, 5).FormulaR1C1 = VARbalG
            Cells(1 + eachlinecheck, 4) = VARbalP
        
        End If
    
    
        ElseIf Cells(1 + eachlinecheck, 3) = "D" Then                                           'If R1C3 = "D" Then
            VARvalcurrD = Cells(1 + eachlinecheck, 2).Value                                    'VARvalcurrD = R1C2.Value
    
    
            While VARvalREST <> 0                                                               'WHILE >>>> while my VARvalREST is not equal to 0"       ' need to check the actual line amount compared with the oldest usable wallet point amount
                    
                If Application.Min(VARarraydateP) < Application.Min(VARarraydateG) Then         'check is the oldest point is a P or a G  ==> If LBound(VARarraydateP, 0) < LBound(VARarraydateG, 0) Then
                VARvaloldestP = Application.Min(VARarraydateP)                                  'VARvaloldestP = Lbound VARarraydate(col2)
                         
                        If VARvalcurrD < VARvaloldestP Then                                     'if VARvalcurrD < VARvaloldestP
                            VARbalP = VARbalP + VARvalcurrD                                         'balP = balP + R1C2
                            'redim/rerange VARarraydateP range from (1:1) to (1:1) ' 2 lines and swip down to resize little by little    // i can also use a counting number to swip down the camera rather than rewriting
                        
                            ElseIf VARvalcurrD > VARvaloldestP Then                                 'elseif  VARvalcurrD > VARvaloldestP
                                VARbalP = 0                                                             'balP = 0
                                VARvalREST = -(VARbalP + VARvalcurrD)                                   'VARvalREST = -(balP + RxC2)
                                'redim/rerange VARarraydateP range from (1:1) to (1:1) ' 2 lines and swip down to resize little by little    // i can also use a counting number to swip down the camera rather than rewriting
                        
                            End If
                        
                        ElseIf Application.Min(VARarraydateP) > Application.Min(VARarraydateG) Then
                            VARbalG = VARbalG + VARvalcurrD                                    'balG = balG + R1C2
                            'redim arraydateP range from (1:1) to (0:1)
    
                        End If
                End If
                
        End If
    
        Cells(1 + eachlinecheck, 4) = VARbalP
        Cells(1 + eachlinecheck, 5) = VARbalG
    
    Next eachlinecheck


End Sub

Now, coming back to your code, I have few questions/comments to better understand:


1> why do you need to transpose the range in order to put it in the virtual array?
virtually speaking, after the line myARR= worksheet function transpose (rng), myArr looks like this?
table 1
Date value value
Amount value value
Type value value

or that?
table 2

Date Amount Type
value value value
value value value


2> If you use Lbound(myarr,2), is the first column looked by default and the second row?
Later in the code you use Myarr(2,R), so I would have thought that it would look at the 3^rd column and not the 2^nd… since an array starts at 0 and not at 1. Have I missed something?


3> Honestly the figures I gave as an example weren’t great.. normally, D amount should always be inferior to balP+balG. In other words, balP and balG should never be negative
In the new code pasted again, you’ll see that I compare the D value with the value P/G of the oldest transaction. If the difference leave an amount, then I have to read the next transaction to substract that difference remaineder to the proper P or G balance. Until the remainder is VARvalREST is 0.

4> Please correct me if I am wrong but I understand from your code that you put the whole table in an array.
Memory wise I think it is too heavy since the transactions record I need to process is above 100,000 lines.
This is why I thought that it would be better to process like “temporary arrays” where I could to store the minimum amount of transaction record –VARarraydateP and VARarraydateG- as long as the code run through the transactions.
According to you, would that make really a difference in the calculation time?

5> Finally, I need to add one column on the left which is the customer ID. Because I need to do that for each customer individually. One easy way would be to sort the table according the customer and process as long as the customer ID does not change. Then re-initialise.
OR
I can create a virtual array where I would maintain a unique list of customer with the final balances.


Thanks to you, I understood more or less how to use the Case function which I have never used before.

Thank you again for your insights. I might post one more time by the time you will probably see this message with the code updated. J

Sorry for the long text

Shiro

 

[CalcSux78]

Shiro:

1. No need to transpose array. I needed to on the current project I am working and got carried away. If not using the Transpose function, your array would be (Row, Column) so all array references within the code would need to be switched.
2. The lower bound of this array is 1 for both dimensions.
4. In my experience, processing from an array is the most efficient way to comb through the data. My last project had over 27,000 rows and 14 columns of data. Putting the entire data set in an array and looping through the array, sending back to the worksheet in the same method posted, my calculations were completed in 1.8 seconds. A few years ago I had a similar project and data size and tried looping through each of the items in the data range (Non-Array method) and it took over 4 hours to complete the subroutine.
5. It should be possible to add the new column to the array and include in your loop through the data. It may be easier to debug if the data is presorted by customer ID, but shouldn't be required to get correct calculations.