Create a dynamic list

Question

I have an excel sheet. I want to create a list which will be in 5 cells. For simplicity, lets call the items in the list as (item1, item2, item3, item4, item5). If I select "list1" from a cell-1, the item-contents in other list should become (item2, item3, item4, item5) and upon scrambled; the list should re-include the data into the list.

I have tried the following:

Sub PopulatingArrayVariable()
'PURPOSE: Dynamically Create Array Variable based on a Given Size

Dim myArray() As Variant
Dim DataRange As Range
Dim cell As Range
Dim x As Long

'Determine the data you want stored
 Set DataRange = ActiveSheet.UsedRange

'Resize Array prior to loading data
ReDim myArray(DataRange.Cells.Count)

'Loop through each cell in Range and store value in Array
For Each cell In DataRange.Cells
  myArray(x) = cell.Value
  x = x + 1
Next cell

End Sub

Example:

Suppose there are 3 cells A, B, C. All these cells will have this list ( Consider this as a list that we see in data-validation or a static array). So, our cells will have the values in the list like ( NY, NJ, LA ). Once we select an element (NY) from cell A, the remaining elements of list to be shown in cell B, C should be ( NJ, LA). If this NY is selected by any other cell then it should not show up in cell B, C.

Answer 1

So little confused as to what you mean by "If I select "list1" from a cell-1, the item-contents in other list should become (list2, list3, list4, list5) and upon scrambled; the list should re-include the data into the list.".. but to write a sub to populate a 1D array with a sheets used range you are very close- in fact I think you code should work with just 1 simple change:

Sub PopulatingArrayVariable()
'PURPOSE: Dynamically Create Array Variable based on a Given Size

Dim myArray() As Variant
Dim DataRange As Range
Dim cell As Range
Dim x As Long

'Determine the data you want stored
 Set DataRange = ActiveSheet.UsedRange

'Resize Array prior to loading data
ReDim myArray(DataRange.Cells.Count)

'Loop through each cell in Range and store value in Array
For Each cell In DataRange.Cells
  x = x + 1
  myArray(x) = cell.Value
Next cell

End Sub

A couple things I will say however, 1) it is a good idea to use Option Explicit- it has saved me from a ton of coding mistakes that I potentially wouldn't have found until after hours of excruciating troubleshooting... 2) If you were to use Option Explicit and could no longer use For Each cell In DataRange.Cells syntax, this is how would re-write the sub:

Sub PopulatingArrayVariableVersion2()
'PURPOSE: Dynamically Create Array Variable based on a Given Size

Dim myArray() As Variant
Dim tempArr() As Variable 'Temp Array to read in data range
Dim DataRange As Range
Dim rowCounter As Long 'For looping through tempArr's Rows
Dim colCounter As Long 'For looping through tempArr's Cols
Dim arrWriter As Long 'Need additional variable to store the element of array to write to

'Determine the data you want stored
 Set DataRange = ActiveSheet.UsedRange

'Resize Array prior to loading data
ReDim myArray(DataRange.Cells.Count)
tempArr = DataRange 'Load in DataRange as array

'Loop through row,col in tempArr and store value in Array
For rowCounter = 1 To UBound(tempArr, 1)
    For colCounter = 1 To UBound(tempArr, 2)
        arrWriter = arrWriter + 1
        myArray(arrWriter) = tempArr(rowCounter, colCounter)
    Next
Next

End Sub

Also I think using an array instead of reading from a range each time will end up being faster-

Hope this helps, TheSilkCode

Answer 2

Okay now I see what you are trying to do- you are trying to populate a cells data validation drop down list with the values from another sheets used range... So you are on the right track but the issue is that data validation actually expects a string with elements comma delimited, not an array... so the final code would look like:

Public Sub setValidationList()
Dim targetCell As Range
Set targetCell = ThisWorkbook.Sheets(1).Range("A1")
With targetCell.Validation
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=getValidationList
End With
End Sub

Public Function getValidationList() As String
Dim dataRange As Range
Dim listStr As String
Dim tempArr() As Variant 'Temp Array to read in data range
Dim rowCounter As Long 'For looping through tempArr's Rows
Dim colCounter As Long 'For looping through tempArr's Cols

Set dataRange = ThisWorkbook.Sheets("Sheet1").UsedRange
tempArr = dataRange

'Loop through row,col in tempArr and store value in Array
For rowCounter = 1 To UBound(tempArr, 1)
    For colCounter = 1 To UBound(tempArr, 2)
        listStr = listStr & IIf(listStr <> "", ",", "") & CStr(tempArr(rowCounter, colCounter))
    Next
Next
getValidationList = listStr
End Function

Hope this helps, TheSilkCode

Answer 3

edited to add the code of GetRangeFromValidationFormula() function (previously named GetRange())

as per your example added in your question, you may try to add the following code in the relevant worksheet code pane:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim listRng As Range, validationRng As Range, cell As Range, cell2 As Range
    Dim changedValue As String

    Set listRng = Range("A1:A3") '<--| this are your "3 cells A, B, C"

    If Not Intersect(Target, listRng) Is Nothing Then
        changedValue = Target.value
        Set validationRng = GetRangeFromValidationFormula(Target.Validation.Formula1)

        Application.EnableEvents = False
        On Error GoTo ExitSub
        listRng.ClearContents
        For Each cell In listRng
            If cell.Address = Target.Address Then
                cell.value = changedValue
            Else
                For Each cell2 In validationRng
                    If listRng.Find(what:=cell2.value, LookIn:=xlValues, lookat:=xlWhole) Is Nothing And cell2.value <> changedValue Then
                        cell.value = cell2.value
                        Exit For
                    End If
                Next
            End If
        Next
    End If

ExitSub:
    Application.EnableEvents = True
End Sub


Function GetRangeFromValidationFormula(validationFormula As String) As Range
    Dim list As Variant
    list = VBA.Split(Replace(ActiveCell.Validation.Formula1, "=", ""), "!")

    If UBound(list) > 0 Then
        Set GetRange = Worksheets(list(0)).Range(list(1))
    Else
        Set GetRange = Range(list(0))
    End If
End Function