0

I'm trying to create an array with only unique values (Signal Names). For example my spreadsheet looks like this

Voltage Voltage Voltage Current Current Current etc....

I've got 32 signals however, I want this to work even if I don't know I have 32 signals explicitly i.e. 17 signals.

Signals("Voltage", "Current", "Etc....")

IN THE CODE BELOW

I realize I'm trying to ReDim an array within a loop and that's the problem. I'm just not able to think of another way of doing this. I would prefer to keep it as an array problem and not a dictionary or collection problem for now.

Public Sub Signals()

Dim myArray() As Variant
Dim Signals() As Variant
Dim element As Variant
Dim intA As Integer

WsName = ActiveSheet.Name

intRows = Sheets(WsName).Range("B2", Sheets(WsName).Range("B" & Sheets(WsName).Rows.Count).End(xlUp)).Rows.Count
intRows = intRows + 1

ReDim Signals(1)
Signals(1) = Sheets(WsName).Cells(4, 2).Value

For intA = 4 To intRows
    For Each element In Signals()
        If element <> Sheets(WsName).Cells(intA, 2) Then
            ReDim Signals(UBound(Signals) + 1) 'This throws the error
            Signals(UBound(Signals)) = Sheets(WsName).Cells(intA, 2).Value
        End If
    Next element
Next


End Sub

How the code doesn't work - RunTime Error '10' Array is temporarily fixed or locked.

DBraun
  • 38
  • 1
  • 7
  • 2
    1-D arrays are zero-based by default, not 1-based. `ReDim Signals(1)` creates an array of `Signals(0 to 1)` with two elements, not one. –  Dec 26 '18 at 17:20
  • 1
    Your problem goes away if you use a scripting.dictionary. – freeflow Dec 26 '18 at 17:21
  • @Freeflow The OP clearly states that the issue is about arrays and information about dictionaries and collections is not desired. – Cindy Meister Dec 26 '18 at 17:25
  • @user10829321 Ah okay, so I know Arrays are zero-based but I didn't know if I needed to initialize it as Signals(0) to make have it contain one value. – DBraun Dec 26 '18 at 17:27
  • Welcome to Stack Overflow :-) It helps others to help you when all relevant information is included in the question. Sometimes, it's possible to guess, but not always. This question is missing a description of *how* the code doesn't work. If there's an error, the error message should be included as well as the line of code that triggers the error. If the result is incorrect it helps to have a description of the desired result as well as the result the code produces. – Cindy Meister Dec 26 '18 at 17:27
  • 1
    I appreciate that the OP isn't interested in a collection or dictionary answer but the use of a dictionary is the easiest way to the array that the OP desires. With a scripting.dictionary you can obtain an array of the items using the .Items method. Consequently I'd recommend a dictionary as an intermediate step to getting the desired array. – freeflow Dec 26 '18 at 17:34
  • The fastest solution for unique values using Autofilter: [Spare a Column](https://stackoverflow.com/questions/53891590/vba-create-empty-lists-and-then-append-elements-to-that-list/53892239#53892239) – VBasic2008 Dec 26 '18 at 17:37
  • 1
    FWIW arrays being zero-based is just a default; `Option Base` controls the lower bound of implicitly-sized arrays, with the default being `Option Base 0`. Also... keeping this an "array problem" makes it an inefficient O(n^2) solution. Resizing an array is a costly operation, and repeatedly resizing it by one incurs serious overhead. If you don't know how many items you're going to need from the start, you shouldn't be using an array. Knowing what data structure to use, and when to use them, is more important than knowing how to abuse arrays. – Mathieu Guindon Dec 26 '18 at 17:40

2 Answers2

2

I posted a solution to this issue using arrays in a similar question a couple days ago - using column B for your case, this would do the trick.

Aside from this solution, you have several problems in your current code - you're testing against each individual element in your current array without checking them all first, you're not using ReDim Preserve, and you need (0 to 0), not just a single (0) or (1). You're also naming your subroutine "Signals" while attempting to declare a variable "Signals" in the subroutine as well... That'll cause all kinds of issues.

Sub Test()

Dim list() As Variant
Dim inlist As Boolean
Dim n As Long, i As Long, j As Long, endrow As Long, colnum As Long

ReDim list(0 To 0)
inlist = False
j = 0
colnum = 2 'Column B in this case
endrow = Cells(Rows.Count, colnum).End(xlUp).Row

For n = 1 To endrow
    For i = 0 To UBound(list)
        If list(i) = Cells(n, colnum).Value Then
            inlist = True
            Exit For
        End If
    Next i

    If inlist = False Then
        ReDim Preserve list(0 To j)
        list(j) = Cells(n, colnum).Value
        j = j + 1
    End If

    inlist = False
Next n

For i = 0 To UBound(list)
    Debug.Print list(i)
Next i

End Sub

Even simpler solution thanks to @user10829321's suggestions:

Sub Test()

Dim list() As Variant
Dim n As Long, i As Long, j As Long, endrow As Long, colnum As Long

ReDim list(0 To 0)
j = 0
colnum = 2 'Column B in this case
endrow = Cells(Rows.Count, colnum).End(xlUp).Row

For n = 1 To endrow
    If IsError(Application.Match(Cells(n, colnum).Value, list, 0)) Then
        ReDim Preserve list(0 To j)
        list(j) = Cells(n, colnum).Value
        j = j + 1
    End If
Next n

For i = 0 To UBound(list)
    Debug.Print list(i)
Next i

End Sub
dwirony
  • 5,487
  • 3
  • 21
  • 43
  • `inlist = True` should be followed by `exit for` but `iserror(application.match(Cells(n, colnum).Value, list, 0))` would be true if there were no matches in the array without the loop. –  Dec 26 '18 at 17:32
  • @user10829321 Thanks for your suggestions - I've added the simpler solution to my answer. – dwirony Dec 26 '18 at 17:37
  • @user10829321 It's fine, I appreciate the criticism, and you are right. I had acknowledged this was a poor answer on the original thread, band-aid solutions are ugly :) – dwirony Dec 26 '18 at 17:45
1

An optional, if perhaps unwanted, solution using a scripting dictionary to give an array.

Public Function Signals(ByRef this_worksheet_range As excel.Range) As Variant()

Dim myArray()       As Variant
Dim element         As Variant
Dim interim_dic     As Scripting.Dictionary

    myArray = this_worksheet_range.values2

    Set interim_dic = New Scripting.Dictionary

    For Each element In myArray
        If Not interim_dic.Exists(element) Then
            interim_dic.Add Key:=element, Item:=element
        End If
    Next

    Signals = interim_dic.Items

End Function
freeflow
  • 4,129
  • 3
  • 10
  • 18
  • thank you for taking the time to show me the correct method for approaching the problem! – DBraun Dec 26 '18 at 18:10
  • You can get rid of the .Exists check if you use the shorthand/overwrite dictionary .Add method, e.g. `interim_dic.Item(element) = element`. While it won't make much difference for 17-32 records, it actually makes a big improvement for larger (100K) records. –  Dec 26 '18 at 18:11
  • Yes. But I assumed that the OP wasn't familiar with dictionaries so I tried to keep it as simple as I could. – freeflow Dec 26 '18 at 18:23
  • @Freeflow So can you explain why you're using .value2 instead of .value; I'm reading another thread regarding the explanation which summarized basically says always use .value2 but I would like your input regarding this particular situation. \n it would be nice of you to explain the "Signals(ByRed this_worksheet_range As excel.range)" OH IS IT SIMPLY YOUR WAY OF TELLING ME TO USE MY OWN RANGE IN PLACE OF THAT VARIABLE YOU HAVE FOR EXAMPLE "myArray = Sheets(WsName).Range("B1").values2" – DBraun Dec 27 '18 at 16:21
  • .Value takes note of the locale whereas .Value2 doesn't. Your initial question was to get an array of unique values from an excel range. That's a function description. When I looked at your code it was easy to consolidate things into a function which took an excel range and returned the desired array. Organizing code into functions/subs that do one thing and one thing well makes your code more readable and easier to update/maintain. – freeflow Dec 28 '18 at 11:36