Store rows numbers in 1d array

[YasserKhalil]

Hello everyone
I have values in column B starting from row 3.
If the value is unique and repeated for once then to store that row in the 1d array. If the value is not unique then to store the last occurrence not the first occurrence.

[HansV]

If the values are the same, it doesn't matter whether you store the first occurrence or the last occurrence in the array - they are identical.
I assume that you meant something else...

[YasserKhalil]

Yes the values are identical in that column but there are other columns related that have different values and I need only the last occurrence

[HansV]

But you mentioned that you wanted to populate a one-dimensional array. If you store the unique values from column B in the array, there is no difference between occurrences of the same number.
If you want to store values from multiple columns, you'd need a two-dimensional array.

[YasserKhalil]

I have got a solution like that

Code: Select all

Sub Test()
    Dim v, ky, ws As Worksheet, dict As Object, lr As Long, i As Long, ii As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Sheets("Sheet1")
        With ws
            lr = .Cells(ws.Rows.Count, "B").End(xlUp).Row
            Set dict = CreateObject("Scripting.Dictionary")
            For i = 3 To lr
                v = .Cells(i, "B").Value
                If dict.Exists(v) Then
                    dict(v) = i
                Else
                    dict.Add v, i
                End If
            Next i
            ReDim a(1 To dict.Count)
            ii = 1
            For Each ky In dict.Keys
                a(ii) = dict(ky)
                ii = ii + 1
            Next ky
        End With
    Application.ScreenUpdating = True
End Sub

[HansV]

You can shorten

Code: Select all

            ReDim a(1 To dict.Count)
            ii = 1
            For Each ky In dict.Keys
                a(ii) = dict(ky)
                ii = ii + 1
            Next ky
 

to

Code: Select all

    Dim a
    a = dict.Items

[DocAElstein]

If the number 25 occurs in B3 and in B20, you store 25 in the array and you won't be able to tell whether this is the value of B3 or the value of B20.

I think perhaps he wants the row number in his 1 D array, not the value, and perhaps the last row that a value occurs if it occurs more than once.
If that is the case, then perhaps an idea would be to simply fill a dictionary looping backwards, making the key each value, ( only if the key does not exist), and the item the row number.
So then the final items array would be the 1 D array he wanted

As ever, a short sample file showing what he wanted would have made it a lot clearer…

[HansV]

He is in fact storing the row numbers instead of the values.

[YasserKhalil]

Thank you very much. You are very helpful both of you.

[DocAElstein]

This would be the way to do it similar to the Yasser / Hans coding , but backwards looping, which simplifies it and gets the correct results, (but the results are in a different order to what the Yasser / Hans coding gets)

Code: Select all

  '  https://eileenslounge.com/viewtopic.php?f=30&t=41033
Sub Alan1OneDimensionArrayOfRowNumberOfLastValueOccurrance()  '   https://eileenslounge.com/viewtopic.php?p=317500#p317500
Dim v, ky, ws As Worksheet, dict As Object, lr As Long, i As Long, ii As Long
    Set ws = ThisWorkbook.Sheets("Sheet1")
    With ws
        lr = .Cells(ws.Rows.Count, "B").End(xlUp).Row
        Set dict = CreateObject("Scripting.Dictionary")
        For i = lr To 3 Step -1
            v = .Cells(i, "B").Value
            If Not dict.Exists(v) Then ' Do it right - Mike - https://eileenslounge.com/viewtopic.php?p=315869#p315869
                dict(v) = i
            Else
            End If
        Next i
    Dim a() As Variant: Let a() = dict.Items()
    End With
 
 
 
 Let Range("F5").Resize(1, UBound(a()) + 1) = a()
 Let Range("F6").Resize(1, UBound(dict.Keys()) + 1) = dict.Keys()
End Sub

If you do the filling of the dictionary a bit unprofessionally, then you can simplify it a bit further, ( and loop normally forwards), and the results are in the same order as that got from the Yasser / Hans coding

Code: Select all

 '    ( Mike - bad way to do it -  https://eileenslounge.com/viewtopic.php?p=315869#p315869 )
Sub Alan2OneDimensionArrayOfRowNumberOfLastValueOccurrance()  '   https://eileenslounge.com/viewtopic.php?p=317500#p317500
Dim v, ky, ws As Worksheet, dict As Object, lr As Long, i As Long, ii As Long
    Set ws = ThisWorkbook.Sheets("Sheet1")
    With ws
        lr = .Cells(ws.Rows.Count, "B").End(xlUp).Row
        Set dict = CreateObject("Scripting.Dictionary")
        For i = 3 To lr
            v = .Cells(i, "B").Value
'            If Not dict.Exists(v) Then ' Do it right - Mike - https://eileenslounge.com/viewtopic.php?p=315869#p315869
                dict(v) = i  '  If the Key does not exist then it will be made, and if later there is a duplicate key value then then the item ( row number ) will be updated
'            Else
'            End If
        Next i
    Dim a() As Variant: Let a() = dict.Items()
    End With
 
 
 
 
 Let Range("F7").Resize(1, UBound(a()) + 1) = a()
 Let Range("F8").Resize(1, UBound(dict.Keys()) + 1) = dict.Keys()
End Sub














Sub YasserHansTest() '  https://eileenslounge.com/viewtopic.php?p=317496#p317496
    Dim v, ky, ws As Worksheet, dict As Object, lr As Long, i As Long, ii As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Sheets("Sheet1")
        With ws
            lr = .Cells(ws.Rows.Count, "B").End(xlUp).Row
            Set dict = CreateObject("Scripting.Dictionary")
            For i = 3 To lr
                v = .Cells(i, "B").Value
                If dict.Exists(v) Then
                    dict(v) = i
                Else
                    dict.Add v, i
                End If
            Next i
'            ReDim a(1 To dict.Count)
'            ii = 1
'            For Each ky In dict.Keys
'                a(ii) = dict(ky)
'                ii = ii + 1
'            Next ky
'           Hans   https://eileenslounge.com/viewtopic.php?p=317497#p317497
            Dim a()
            a() = dict.Items
        End With
    Application.ScreenUpdating = True





 Let Range("F3").Resize(1, UBound(a()) + 1) = a()
 Let Range("F4").Resize(1, UBound(dict.Keys()) + 1) = dict.Keys()
End Sub

[snb]

Avoid multiple reading/writing in a worksheet.

Code: Select all

Sub M_snb()
   sn = Range("B3:B20")
   
   With CreateObject("scripting.dictionary")
     For j = 1 To UBound(sn)
       x0 = .Item(sn(j, 1))
     Next
     For j = 1 To UBound(sn)
       .Item(sn(j, 1)) = j + 2
     Next
   
     Cells(10, 5).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
   End With
End Sub

And the simplest method is the pivottable

[YasserKhalil]

Thank you very much for these wonderful solutions.

[DocAElstein]

Avoid multiple reading/writing in a worksheet.

Certainly a good valid point. I don’t disagree with you. I doubt Yasser does either as I know he is a big fan of doing things in VBA arrays.
( I think perhaps the inputting and outputting of data was a secondary issue, certainly I just added output to conveniently show the result comparison. Having said that, the way you output is interesting. It looks like another interesting use of that strange phenomena we noticed a few times, whereby a 1 dimensional array of 1 dimensional arrays inside it, looks like a 2 dimensional array to some things provided the arrays in side are the same size. I had seen that in Index, before, but not in Transpose.)

Your solution is similar to my second one, ( or would be if you avoid unnecessary multiple looping…..)

Code: Select all

 Sub M_snb()  '  https://eileenslounge.com/viewtopic.php?f=30&t=41033
   sn = Range("B3:B20")
   
   With CreateObject("scripting.dictionary")
     For j = 1 To UBound(sn)
      .Item(sn(j, 1)) = j + 2
     Next
'     For j = 1 To UBound(sn)
'      .Item(sn(j, 1)) = j + 2
'     Next
   
    Cells(3, 5).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
    Let Range("L8").Resize(2, .Count) = Application.Index(Array(.items, .keys), 0, 0)
   End With
End Sub

Code: Select all

 Sub M_snbAlan() '  https://eileenslounge.com/viewtopic.php?p=317519#p317519
Dim Sn() As Variant, J As Long  '  , x0 As Variant
 Let Sn() = Range("B3:B20").Value2
   
   With CreateObject("scripting.dictionary")
     For J = 1 To UBound(Sn)
      Let .Item(Sn(J, 1)) = J + 2
     Next
   
'     Cells(3, 5).Resize(.Count, 2) = Application.Transpose(Array(.Keys, .Items))
    Let Range("L9").Resize(2, .Count) = Application.Index(Array(.items, .keys), 0, 0)
   End With
End Sub

__ForwardsBackardsForwardsUnics.JPG

_.________________-


Incidentally, snb, just passing interest… So we are both using the feature that if you try to do something with a key that does not exist, then that key is made. That is why we can do away with the
If dic.Exists(KeyX
Stuff in the loop. I think I picked up that from you some time ago. Seems neat.
But more recently there was some criticism that it might not be such good practice . I don’t think it’s a major issue one way or another to anyone, but just out of curiosity I wonder what your views are on it?


Alan

[snb]

@Doc

You didn't comment on the pivottable, that's the most elegant approach.

You are quite right on redundant double looping.

Code: Select all

Sub M_snb()
   sn = Range("B3:B20")
   
   With CreateObject("scripting.dictionary")
     For j = 1 To UBound(sn)
       .Item(sn(j, 1))=j+2
     Next
   
     Cells(10, 5).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
   End With
End Sub 

Too often what is called 'not so good a practice' means only: 'it's a practice that I'm not familiar with' or 'that I haven't be taught'. A lot of prgrammers are afraid to explore the possibilities of a programming language, they do just what they have been taught and stick to that.

[DocAElstein]

Ok, thanks
( I can’t make any comment about the pivot table as I know absolutely nothing about them. ( Its on my list along with Power Query and a lot of other Excel , VBA and a bit of Word stuff that I think would be very useful to learn and I want to, but I am really much too busy for now trying to understand much better the very small part of Excel, VBA and Windows that I do know about. ) )

[p45cal]

MS365, Excel 2021, Excel 2023?
Formula:

Code: Select all

=LAMBDA(rng,LET(b,SEQUENCE(ROWS(rng)),FILTER(b,XMATCH(rng,rng,,-1)=b)))(B3:B20)

VBA:

Code: Select all

Sub p45calTest()
Dim s
With Range("B3:B20")
s = Evaluate("LAMBDA(rng,LET(b,SEQUENCE(ROWS(rng)),FILTER(b,XMATCH(rng,rng,,-1)=b)))(" & .Address(, , , True) & ")") '2d array (1 column on a sheet)
s = Application.Transpose(s) '1d array
End With
End Sub

2024-05-21_234253.jpg

[SpeakEasy]

>there was some criticism that it might not be such good practice

You seem to be talking about my comments about this, which you are slightly misrepresenting. I was simply pointing out that "automatically adding previously non-existent entries every time we try and access the Item property I consider a bad design decision from Microsoft" since "adding new key/item pairs to a dictionary should really be an explicit action dictated by the programmer, not something that magically happens in the background". Nevertheless, as I also pointed out, "there are certainly occasions where this behaviour can prove useful". And this is one of those occasions.

[DocAElstein]

Yes, sorry, if I misrepresented what you said, - that will be down to me being a bit slow at getting the point as always.

As well as specifically referring to what you said, I meant it also as a general remark as it seems that in a lot of similar codings that could have done the simple loop without the extra
If dic.Exists(KeyX
Stuff, people were not using that way and were instead doing the extra If dic.Exists(KeyX Stuff.

The problem for me is that on any questioning of people before on why they did not use the simpler loop, I either never got any response, or they seemed to want to kill me for asking.
At the end of the day, I am just trying to get a good understanding, and you are one of the few people who know it and seem happy to tell it, explain, or justify it as well. So I give you the blame more than others, Lol , for getting finally a few things in my thick head.

When I finally understand, it means I can move on rather then getting annoyingly stuck on something trying to understand it fully. So I am always very grateful, thanks. (I don’t care one way or the other if I get hammered for being stupid and wrong most of the time, as long as I get the right answer in the end. So I can move on, and maybe then later help others to as well – it seems there is an awful lot of repeated time wasting in this business, where we almost get there, but don’t quite, so go away and start again. A bit like trying to get over a Hill, and always quitting just before the peak and rolling back to start again another day instead of going the extra mile to get over the top and have a nice roll down the other side. Maybe fear of what might be on the other side I guess. So far it’s usually been finally rewarding for me, )


I think perhaps I am right in suggesting that it is not such a big issue one way or the other?
I have a small tendency now to think again if I might include the extra If dic.Exists(KeyX Stuff , when I could get away without it.
Or I use it, but stick some extra notes about our discussions over to the right in the 'comments. I would compare it to driving a car like anyone else does, but knowing a bit more about how the engine works may make me occasionally drive a bit differently, and usually that would be a good idea , in the long run, - I might have a healthier roll down the hill finally

_.____________



In fact. Rethinking, I see there is the difference now between how I am using the feature here, and how it is more typically used.
Originally in snb’s version he was doing the typical thing that I have often seen, (or often not seen when it could have been done to get rid of the extra If dic.Exists(KeyX Stuff ) , pseudo like

Code: Select all

     For j = 1 To 
       AnyVariable = .Item(Key that may or may not exist)
     Next

That perhaps is what you might consider not such a good thing, as you said ? Or not? I may have missed the point again.


But in my second coding, ( Sub Alan2OneDimensionArrayOfRowNumberOfLastValueOccurrance()
) and my modified version of snb's, something slightly different is going on, but using the same basic feature ( that of that if you try to do something with a key that does not exist, then that key is made.)
It's doing this, pseudo like

Code: Select all

     For j = 1 To 
       MakeTheItem(of Key that may or may not exist) = a value
     Next

Which is a bit different. The only possibly slightly "bad" thing we are doing is changing the item a few times if there are duplicate values, which we would not if the extra If dic.Exists(KeyX was included

I have not seen that way done before, since in most uses of this sort, the item is not wanted, as only a single column unique list is wanted, and usually just the key is used, and a variable given some form of nothing, ( which might not always be clever?? – I don't know) via the
AnyVariable = .Item(Key that may or may not exist)
bit.
In fact, the same was the case of here, as Yasser effectively only wanted to get the row number of a single ( the last ) occurrence of the value. I introduced getting two columns out, just for the hell of it.
Perhaps in doing so I tripped over a less bad way to use the feature of if you try to do something with a key that does not exist, then that key is made.
(Although I don’t doubt someone did it before, I just never noticed. Perhaps snb had not noticed as well that's why he had the extra redundant loop before it originally?)


There was also the extra advantage here of that doing it in the way of my second coding, ( Sub Alan2OneDimensionArrayOfRowNumberOfLastValueOccurrance()
) , got the same order as Yasser’s code attempt. (I have no idea what order he preferred)

So all in all, using the feature of if you try to do something with a key that does not exist, then that key is made, was perhaps a bit more useful here.

[SpeakEasy]

>So I give you the blame

My wife does the same thing ...

[DocAElstein]

That’s maybe it is as it should be. I always say the wife and her actions are the reason for many things that effect us, but it’s my fault, ! are to blame…