Assign multiple named ranges to multiple range arrays - excel

Question

I'm kinda new here, but here is what I'm trying to do.
I have a book lets pretend its a warehouse book for inventory, and we have different divisions in our enterprise, I have master sheet with all the goods and some sheets covering those divisions for distribution of goods between them.
My idea is to have a drop down list for each item type in book for separate divisions so i need macro to assign/reassign named range for each item.
I have 2 columns first with stock number and second with serial number , i need to put all the same serial number in the named range of one of stock numbers. if i have two or more serial numbers i need to put an array of serial numbers in named range of one stock number.
Stock numbers are in C column and serial numbers are in D column
I've tried this code
Private Sub CommandButton2_Click()
Dim LastRow As Long
Dim r As Range
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
For Each r In Range("C2:C" & LastRow)
Range(r.Offset(0, 1), r.Offset(0, 1)).Name = r.Value
Next r
End Sub
But thats not realy working, and assigns only one serial number per one named range of stock numbers
================================================================
So i ran this code you proposed in your updated version and struck some problems
Private Sub CommandButton2_Click()
Dim this As Worksheet: Set this = Sheets("ALFA")'renamed this for my book'
Dim that As Worksheet: Set that = Sheets("STORAGE")'renamed that for my book'
serialNumbers = that.Range(that.Columns(3), that.Columns(4))'Could not find method Unique(and there is no mentions about'
'it in MS documentation) for Application object so i changed it to just Range'
For r = 2 To this.UsedRange.Rows.Count
buffer = ""
comma = ""
stockNumber = this.Cells(r, 3)
For x = 2 To UBound(serialNumbers)
If serialNumbers(x, 1) = stockNumber Then
buffer = buffer & comma & serialNumbers(x, 2)
comma = ","
End If
Next
this.Cells(r, 4).Validation.Delete
this.Cells(r, 4).Validation.Add _'After doing everything it strucks with Run time error 1004
Type:=xlValidateList, _ '/Application-defined or object-defined error in this
AlertStyle:=xlValidAlertStop, _'hole'
Formula1:=buffer 'block'
Next
End Sub
And sometimes code just hangs my excel application for atleast 3 mins, i think it's because there is no limit for cells to look up to and eventualy it tries to give all the cells in D:D a validation check

Answer 1

So if you want to set the validation, it is possible to set dynamic ranges BUT the validation won't accept a text list, for instance "one, two, three". The validation is looking for an array of values, and unfortunately it is tricky to pass a dynamic array using formulas only. You can set it up to do a dynamic range, but that would have to point to a range of cells that contain the needed values one per cell.
However, before you set all that up it's probably just easier to set the validation entirely in code. See this google sheet, which just contains the layout for reference. I have the complete list of items in Column 1 & 2 of the sheet (Item, Stock Number) and the complete list of serial numbers in columns 5 & 6 (Stock Number, Serial Number).
Then I run this code:
Sub setValidation()
Dim this As Worksheet: Set this = Sheets("demo")
Dim that As Worksheet: Set that = Sheets("lookups")
serialNumbers = Application.Unique(that.Range(that.Columns(5), that.Columns(6)))
For r = 2 To this.UsedRange.Rows.Count
buffer = ""
comma = ""
stockNumber = this.Cells(r, 3)
For x = 2 To UBound(serialNumbers)
If serialNumbers(x, 1) = stockNumber Then
buffer = buffer & comma & serialNumbers(x, 2)
comma = ","
End If
Next
this.Cells(r, 4).Validation.Delete
this.Cells(r, 4).Validation.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=buffer
Next
End Sub
We assign some worksheet variables to make it easier to reference them, and then put the stock number/serial number combos into an array (with UNIQUE so I don't have to check for duplicates).
Then I run through the range that needs the validations (demo column 4), getting the stock number from column 3 and then using that stock number to find all serial numbers that match, concatenating them into a string and then using that string to set the validation.
Use Validation.Delete before setting the validation to avoid stacking rules.
Assuming that your version of Excel doesn't have UNIQUE, you can use INTERSECT to control the size of the serialNumbers array, like this:
Sub setValidation()
Dim this As Worksheet: Set this = Sheets("demo")
Dim that As Worksheet: Set that = Sheets("lookups")
serialNumbers = Intersect( _
that.Range(that.Columns(5), that.Columns(6)), _
that.UsedRange _
)
For r = 2 To this.UsedRange.Rows.Count
buffer = ""
comma = ""
stockNumber = this.Cells(r, 3)
For x = 2 To UBound(serialNumbers)
If serialNumbers(x, 1) = stockNumber Then
buffer = buffer & comma & serialNumbers(x, 2)
comma = ","
End If
Next
this.Cells(r, 4).Validation.Delete
this.Cells(r, 4).Validation.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=buffer
Next
End Sub
Assuming you do have UNIQUE and FILTER in your Excel version, there is another way to do it, using the EVALUATE function to access the Excel function engine. In this case we will just write out a formula just like we would in a cell, and then evaluate it from VBA. Unless specified, evaluate occurs in the context of the active sheet, so that's what I use that.evaluate in this code:
Sub setValidation()
Dim expr As String
Dim this As Worksheet: Set this = Sheets("demo")
Dim that As Worksheet: Set that = Sheets("lookups")
For r = 2 To this.UsedRange.Rows.Count
stockNumber = this.Cells(r, 3)
expr = "Textjoin("","", true, Unique(Filter(F:F, E:E=""" & stockNumber & """)))"
serialNumbers = that.Evaluate(expr)
this.Cells(r, 4).Validation.Delete
this.Cells(r, 4).Validation.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=serialNumbers
Next
End Sub
In this case, we use FILTER to return ONLY the serial numbers that match a stock number, UNIQUE to make sure there are no duplicates, and then TEXTJOIN to create a list from that, and then we can just pass that result straight to the validation.
===================================================
Original answer, shows how to get a list of all serial numbers for a specific stock number using only excel formulas, but it became clear that this wouldn't be sufficient, since the lists were going to be used to set validation. Left here for completeness.
So you have two columns, C and D, and you need to get a list of all values in D that match the entries in C. This is actually simple enough to not need code, but you may have more requirements. I'm going to start an answer with just a very basic set of formulas. See this google sheet.
To get a unique list of the stock numbers, I have used UNIQUE(C:C) in G1. This will produce the list in column G.
Then in column H, I have used TEXTJOIN+UNIQUE+FILTER to produce a comma separated list of serial numbers. FILTER takes one input array (in this case Col D) and filters it with another array (Col C) and a condition (the serial number) to return a list of matches, and wrapping that in UNIQUE makes sure that the result array contains only unique values. Wrapping that in TEXTJOIN converts the result array into text.
What I'm not entirely clear on is your need for a named range, or what you will do with the multiple rows in a sheet. For instance, STORAGE rows 35 & 36 are both for DDG_33:
DDG_33 0BV1111
DDG_33 0AV0951
and if you ran some code to produce a list of values and put it in D35 you would have:
DDG_33 0BV1111, 0AV0951
DDG_33 0AV0951
but you would still have two entries for DDG_33. If you ran the code again, you would have
DDG_33 0BV1111, 0AV0951, 0AV0951
DDG_33 0AV0951
and so forth in an infinite loop. It seems like you would need to take the list of unique stock numbers and put them on a different sheet, along with the list of matching serial numbers, but just clarify what you want to do and I can update my answer.