Creating dynamic List on Workbook Startup

Good morning everyone,
I'm trying to create a dynamic list once Workbook is open. Can you guys help me what is wrong with my code?

Code:

---

Private Sub Workbook_Open(ByVal Target As Range)
Dim d As Object, i&, arr '
    Set d = CreateObject("scripting.dictionary")
    arr = Worksheets("Temp").Range("_Nompipesize")
    Worksheets("Calc").Range("E2").Value = ""
With d
    For i = 1 To UBound(arr)
        If Not .Exists(arr(i, 1)) Then d(arr(i, 1)) = ""
    Next i
    End With
    If d.Count > 0 Then
        With Worksheets("Calc").Range("E2")
            .Validation.Delete
            .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=Join(d.Keys, ",")
            .Value = d.Keys
        End With
    End If
End Sub


---

Attachment 26411

Declare as:

Code:

---

Private Sub Workbook_Open()

---

Artik

Thanks a lot. Can you tell me one more thing. How to force program not to convert 3/4, 1-1/4 to date.
Attachment 26412

Put an apostophe before it... '3/4

Quote:

---

Originally Posted by paulked

Put an apostophe before it... '3/4

---

I did still changes to date format. it is really enjoying

Attachment 26421

I think you're over complicating it

Sizes are in Temp, A1:A8, with '3/4 and '1-3/4

Code:

---

Option Explicit


Private Sub Workbook_Open()


    With Worksheets("Temp")
        On Error Resume Next
        .Names("_Nompipesize").Delete
        On Error GoTo 0
       
        Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Name = "_Nompipesize"
    End With
   
    With Worksheets("Calc").Range("E2")
        .ClearContents
        .Validation.Delete
        .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=_Nompipesize"
    End With
End Sub

---

Quote:

---

Originally Posted by Paul_Hossler

Attachment 26421

I think you're over complicating it

Sizes are in Temp, A1:A8, with '3/4 and '1-3/4

Code:

---

Option Explicit


Private Sub Workbook_Open()


    With Worksheets("Temp")
        On Error Resume Next
        .Names("_Nompipesize").Delete
        On Error GoTo 0
       
        Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Name = "_Nompipesize"
    End With
   
    With Worksheets("Calc").Range("E2")
        .ClearContents
        .Validation.Delete
        .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=_Nompipesize"
    End With
End Sub

---

---

Paul thank you very much. This is really nice code. I forgot to mentioned I don't want any duplicates in the list. Is there a way to do it without creating an Object "scripting.dictionary"?

Quote:

---

I forgot to mention I don't want any duplicates in the list. Is there a way to do it without creating an Object "scripting.dictionary"?

---

Yes, don't put duplicates in the list that the dropdown is built from

Do you need more than that?

Duplicates already exist in the list.
Attachment 26467

OK, then try this

Code:

---

Option Explicit


Sub Macro1()
    Dim r As Range
    Dim i As Long
    Dim s As Variant
   
   
    Set r = Worksheets("Temp").Cells(1, 1).CurrentRegion
    s = "," '  needed
    For i = 1 To r.Rows.Count - 1
        If r.Cells(i, 1).Value <> r.Cells(i + 1, 1).Value Then
            s = s & r.Cells(i, 1).Text & ","
        End If
    Next i
   
    s = Left(s, Len(s) - 1)
   
    With Worksheets("Calc").Range("E2")
        With .Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=s
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End With
   
End Sub

---

Quote:

---

Originally Posted by Paul_Hossler

OK, then try this

Code:

---

Option Explicit


Sub Macro1()
    Dim r As Range
    Dim i As Long
    Dim s As Variant
   
   
    Set r = Worksheets("Temp").Cells(1, 1).CurrentRegion
    s = "," '  needed
    For i = 1 To r.Rows.Count - 1
        If r.Cells(i, 1).Value <> r.Cells(i + 1, 1).Value Then
            s = s & r.Cells(i, 1).Text & ","
        End If
    Next i
   
    s = Left(s, Len(s) - 1)
   
    With Worksheets("Calc").Range("E2")
        With .Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=s
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End With
   
End Sub

---

---

I had to changed the Format Cell to "Text" to make it work. Since I changed it to Text my other code will not work. Would you help me with that ? I've attached the Excel file

It was a little hard for me to follow what you were attempting to do

I'm guessing that after the pipe size was selected, the validation list for the other 2 were to be restricted to only the values for that pipe size

Not a lot of error checking, and I changed the destination columns to B (easier for me to see what's going on)

Standard module:

Code:

---

Option Explicit


Sub ValidString(ValidCol As Long, ValidDest As Range)
    Dim r As Range
    Dim i As Long
    Dim s As Variant
   
    Set r = Worksheets("Temp").Cells(1, 1).CurrentRegion
   
    s = "," '  needed
    For i = 3 To r.Rows.Count - 1
        If r.Cells(i, ValidCol).Value <> r.Cells(i + 1, ValidCol).Value Then
            s = s & r.Cells(i, ValidCol).Text & ","
        End If
    Next i
   
    s = Left(s, Len(s) - 1)
   
    With ValidDest
        .NumberFormat = "@"
        .HorizontalAlignment = xlHAlignRight
        With .Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=s
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End With


End Sub


Sub ValidString2(ValidCol As Long, ValidDest As Range, PrimFilter As String)
    Dim r As Range
    Dim i As Long
    Dim s As Variant
   
    Set r = Worksheets("Temp").Cells(1, 1).CurrentRegion
   
    s = "," '  needed
    For i = 3 To r.Rows.Count - 1
        If r.Cells(i, ValidCol).Value <> r.Cells(i + 1, ValidCol).Value Then
            If r.Cells(i, 1).Value = PrimFilter Then
                s = s & r.Cells(i, ValidCol).Text & ","
            End If
        End If
    Next i
   
    s = Left(s, Len(s) - 1)
   
    With ValidDest
        .NumberFormat = "@"
        .HorizontalAlignment = xlHAlignRight
        With .Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=s
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End With


End Sub

---

ThisWorkbook:

Code:

---

Option Explicit


Private Sub Workbook_Open()
       
    Application.EnableEvents = False
    Call ValidString(1, Worksheets("Calc").Range("B2"))
    Worksheets("Calc").Range("B2").ClearContents
    Worksheets("Calc").Range("B3").ClearContents
    Worksheets("Calc").Range("B4").ClearContents
    Application.EnableEvents = True
 
End Sub

---

Worksheet Calc:

Code:

---

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$B$2" Then Exit Sub
   
    Application.EnableEvents = False
    Call ValidString2(6, Worksheets("Calc").Range("B3"), Worksheets("Calc").Range("B2"))
    Call ValidString2(8, Worksheets("Calc").Range("B4"), Worksheets("Calc").Range("B2"))
    Application.EnableEvents = True


End Sub

---

This works really well. I'm new to VBA so I'm trying do the best I can. It will take me a while before I will fully understand your code but I learn quite a bit. Thank you very much for your help.

Ask questions

The macros were pretty crude and can be more elegant

Apologies for not having more comments

In ver 2 I cleaned up the code a little, and consolidated the two validation macros to eliminate a lot of redundant code