ReDim Preserve Array Error, Dynamic Array

[mkvarious]

hello,

I have a column with data that I work with (let's call it A).
Based on A I get data from AS400 PCCOM IBM emulator (let's call it B).
What I need to check on is whether B data is unique or not.
If B is a duplicate, then I need to check whether C column (value known from the beginning) ins'nt unique.
If C is unique, then I musn't do anything with it, as I can only do a change for B when B is unique or when B isn't unique but then C must be a duplicate, only.
When B isn't unique and when C is unique is a scenario which I cannot follow up.

But not too complicate things, let's just focus on two-dimension array, so pls disregard I have mentioned C, for now.
So my macro goes though A items and is getting B data each time ralated A item is being worked with, so I cannot have a static array with B items as they are not know from the beginning.
So I am trying to build a dynamic array with B items.

I cannot figure it out why ReDim Preserve does't work for me.
Can someone please take a peek into the code below and advise???
thanks

Sub testowe()
Dim cell 
Dim aTabl()
Dim rSOjeden, rSHIPTOjeden, rSOkolejny, rSHIPTOkolejny
Dim lKtóry As Long
For Each cell In Selection
lKtóry = lKtóry + 1
Select Case lKtóry
    Case Is = 1
        rSOjeden = cell.Offset(0, 6).Value
        rSHIPTOjeden = cell.Offset(0, 4).Value
        aTabl = Array(rSOjeden, rSHIPTOjeden)
    Case Else
        rSOkolejny = cell.Offset(0, 6)
        rSHIPTOkolejny = cell.Offset(0, 4)
        ReDim Preserve aTabl(rSOjeden to rSOkolejny, rSHIPTOjeden to rSHIPTOkolejny)
End Select
Next cell
End Sub

 

[mkvarious]

hi p45cal,

am still redoing your code but have not got much time recently I could spent on it so it is not resolved.
what I am doing is redoing the module to call it for each cell in selection but from another module (say start module).
seems I will be contributing from the second option in the end, so one dimension array but with each member or the array being an array of 3 (ship-to, SO and row number I can refer the user to when I got a duplicate of the SO).
the thing is I was receiving some errors when reffering to object (not each time but in certain circumstances), therefore it needs looking into it...
I will let you know on the result once I have solved it, hopefully.

what I wanted to say is this array approach is really fascinating and it definetely has some potential that I for instance can make advantage of as in the case of row number being quoted once duplicate is discovered...

thanks & I hope I will be able to let you know soon I will have finished it!

mkvarious

 

[mkvarious]

hi p45cal,

I got it to work, finally. I have had two major problems that took me some time to identify them, but at least I have learned something new.
the major problem was I was calling 'duplicate' module form the other module and I did not realize each time the code was entering 'duplicate' module then this simple declaration below was killing it...

ReDim aTabl(1 To 1)

So whenever external module was calling 'duplicate' then my aTabl was errased - nice job, isn't it?
but hey, as I said - at least now I know.

the second issue was I each time was increasing iteration of variable 'lKtóry' even in sutuation when the array was not extended.

the below code works fine for me and what it does is:
1) checks if SO is duplicate or not
2) if SO is a duplicate then it checks whether ship-to is duplicate or not
a) duplicate of ship-to is fine as SO can only accept one delivery address at a time - new line is written to the array
b) unique ship-to is not fine obviously and is not written to the array; it sets the boolean 'bDuplicatedSOuniqueSHIPTO' to TRUE and then I do not process SO in my main module
3) whenever SO is unique the array gets extended as well

I have one final question to you, p45cal,

as I have found one dimension array quite useful since I can write three arrays to it (SO, ship-to and row of the duplicate SO) - is there an upper limit that can be declared as arrays for one dimension array?

really greatful for your help - I think I will be now using arrays more often in my future modules.

mkvarious

the code:

Option Explicit
Public aTabl() As Variant
Public lKtóry As Long, bDuplicatedSO As Boolean, bDuplicatedSOuniqueSHIPTO As Boolean
Public lPierwszyWiersz As Long
Sub duplicates()
Dim i As Long
    With cVis
        Select Case lKtóry
            Case Is = 0         '''first SO from the list
                ReDim aTabl(1 To 1)
                lKtóry = lKtóry + 1
                aTabl(lKtóry) = Array(Cells(cVis.Row, czytaj3), Cells(cVis.Row, czytaj2), cVis.Row)
                bDuplicatedSO = False
            Case Else           '''next SO from the list
                For i = LBound(aTabl) To UBound(aTabl)
                    If cVis.Row = aTabl(i)(2) Then Exit For     '''when row that is checked equals row from the array then it quits checking
                    If Cells(cVis.Row, czytaj3) = aTabl(i)(0) Then   '''SO duplicate 
                        bDuplicatedSO = True
                        If Cells(cVis.Row, czytaj2) = aTabl(i)(1) Then    '''ship-to duplicate
'''when both SO and ship-to are the same, then I can write them to table array
                            bDuplicatedSOuniqueSHIPTO = False
                            lKtóry = lKtóry + 1
                            ReDim Preserve aTabl(1 To lKtóry)
                            aTabl(lKtóry) = Array(Cells(cVis.Row, czytaj3), Cells(cVis.Row, czytaj2), cVis.Row)
'''leaving ‘For’
                            Exit For
                        Else            '''cannot update ship-to and write it to the table as it is different for the same SO (SO can only accept one address)
                            bDuplicatedSOuniqueSHIPTO = True
                            lPierwszyWiersz = aTabl(i)(2)
'''leaving ‘For’
                            Exit For 
                        End If
                    Else    '''unique SO
                        '''can only add/write unique SO to the table when the whole table array has been checked
                        If i = UBound(aTabl) Then   '''end of table array, writing new record
                            bDuplicatedSO = False
                            lKtóry = lKtóry + 1
                            ReDim Preserve aTabl(1 To lKtóry)
                            aTabl(lKtóry) = Array(Cells(cVis.Row, czytaj3), Cells(cVis.Row, czytaj2), cVis.Row)
                        End If
                    End If
                Next i
        End Select
    End With
End Sub

 

[p45cal]

is there an upper limit that can be declared as arrays for one dimension array?

I think not except that limited by memory?