Indexing/scripting code issue

[Mr_Ragweed]

I have a userform with 3 dropdowns. The first is Dept. Name, the second is products, the 3rd is completed products. The user chooses a dept and then a product and is directed to the worksheet for that product and determines some pricing levels. When the user clicks the "accept" button on the individual product page many things happen. The pricing formulas he chose are copied to a results sheet, the name and dept of the product are copied to a worksheet called "completed products", and finally the product is removed from the dropdown from which it was chosen. What i'm trying to do is have the "completed products" sheet serve as the index/dictionary for populating the 3rd dropdown mentioned above. I've copied the script used to populate the 1st two dropdowns, modified the names with a "1" or a "2" to avoid confusion, but cant seem to get it to work. I will post the applicable bits of code below.

Original script in the main macro that populates the dept dropdown (created and supplied in part by users of this forum a year ago - thanks again!)

 Dim Dept As Object, FirstRow As Long, LastRow As Long, i As Long
    Dim DataRange As Variant, v As Variant, s As Variant, LastCol As Long, numLins As Long
    
    Set Dept = CreateObject("Scripting.Dictionary")
    Dept.comparemode = vbTextCompare
    
    With Sheets("Master Data") '<-- data sheet.
        'Set first row with data
        FirstRow = 2
        'Get last row with data
        LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
        
        DataRange = .Range("D" & FirstRow & ":E" & LastRow).Value
    End With
    
    With Dept
        For i = 1 To UBound(DataRange, 1)
            If .exists(DataRange(i, 1)) Then
                .Item(DataRange(i, 1)) = .Item(DataRange(i, 1)) & "," & DataRange(i, 2)
            Else
                .Add DataRange(i, 1), DataRange(i, 2)
            End If
        Next i
    End With
    
With Sheets("PrdXDept") '<--destination sheet.
        If Application.CountA(.Range("1:1")) Then
            LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            .Columns("A").Resize(, LastCol).ClearContents
        Else
            LastCol = 1
        End If
            
        i = 0
        For Each v In Dept.keys
            .Range("A1").Offset(, i) = v
            s = Split(Dept.Item(v), ",")
            numLins = Application.Max(numLins, UBound(s) + 1)
            .Range("A1").Offset(1, i).Resize(UBound(s) + 1).Value = Application.Transpose(s)
            i = i + 1
        Next v
        
        'Tunning the results
        With .Range("A1", .Cells(numLins + 1, Dept.Count))
            'Sorting by Department
            .SortSpecial Key1:=.Range("A1"), Order1:=xlAscending, Orientation:=xlSortRows
            'Adjusting column witdh
            .Columns.AutoFit
        End With
    End With
    
Set ORange = Nothing
Set IRange = Nothing
Set Dept = Nothing
Set DataRange = Nothing
'Format Columns
Set WSD = Worksheets("PrdXDept")
FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
FinalCol = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column

    Sheets("PrdXDept").Select
    Columns("A").Select
    ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A2:A" & FinalRow).Select
    Selection.Name = Range("A1")
    Columns("B").Select
    ActiveSheet.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("B2:B" & FinalRow).Select
    Selection.Name = Range("B1")
    Columns("C").Select
    ActiveSheet.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("C2:C" & FinalRow).Select
    Selection.Name = Range("C1")
    Columns("D").Select
    ActiveSheet.Range("D:D").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("D2:D" & FinalRow).Select
    Selection.Name = Range("D1")
    Columns("E").Select
    ActiveSheet.Range("E:E").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("E2:E" & FinalRow).Select
    Selection.Name = Range("E1")
    Columns("F").Select
    ActiveSheet.Range("F:F").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("F2:F" & FinalRow).Select
    Selection.Name = Range("F1")
    Columns("G").Select
    ActiveSheet.Range("G:G").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("G2:G" & FinalRow).Select
    Selection.Name = Range("G1")
    Columns("H").Select
    ActiveSheet.Range("H:H").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("H2:H" & FinalRow).Select
    Selection.Name = Range("H1")
    Columns("I").Select
    ActiveSheet.Range("I:I").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("I2:I" & FinalRow).Select
    Selection.Name = Range("I1")
    Columns("J").Select
    ActiveSheet.Range("J:J").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("J2:J" & FinalRow).Select
    Selection.Name = Range("J1")

Here is the code in the userform:

Private Sub UserForm_Initialize()
'Populates the dept name drop down
Dim rngDeptName As Range
Dim ws As Worksheet
Set ws = Worksheets("Master Data")
For Each rngDeptName In ws.Range("Dept_Name")
Me.DeptDropDown.AddItem rngDeptName.Value
Next rngDeptName
 
 
End Sub
Private Sub DeptDropDown_Change()

Dim ws As Worksheet
Set ws = Worksheets("PrdXDept")

Dim idx As Long
Dim arr As Variant
       idx = DeptDropDown.ListIndex
       If idx = -1 Then Exit Sub ' nothing selected, so exit
       Select Case DeptDropDown.Value
           Case "MASApp"
              arr = ws.Range("MASApp")
           Case "MASChm"
              arr = ws.Range("MASChm")
           Case "MASDry"
              arr = ws.Range("MASDry")
            Case "MASDrM"
                arr = ws.Range("MASDrM")
            Case "MASLiq"
                arr = ws.Range("MASLiq")
            Case "MASLiM"
                arr = ws.Range("MASLiM")
            Case "MASNon"
                arr = ws.Range("MASNon")
            Case "MASSee"
                arr = ws.Range("MASSee")
            Case "MASOth"
                arr = ws.Range("MASOth")
            Case "MASPre"
                arr = ws.Range("MASPre")
           
        End Select
        ProductDropDown.List = arr
 
        
End Sub

Like I said, the above bits work. The part below is giving me fits.

Private Sub CompletedProductDropDown_Change()
 '2nd attempt at trying to figure out where to place the following code
 'added "2's" to everything
 
Dim ws2 As Worksheet
Set ws2 = Worksheets("CompletedProd")
Dim idx2 As Long
Dim arr2 As Variant
       idx2 = DeptDropDown.ListIndex
       If idx2 = -1 Then Exit Sub ' nothing selected, so exit
       Select Case DeptDropDown.Value
           Case "MASApp"
              arr2 = ws2.Range("MASApp1")
           Case "MASChm"
              arr2 = ws2.Range("MASChm1")
           Case "MASDry"
              arr2 = ws2.Range("MASDry1")
            Case "MASDrM"
                arr2 = ws2.Range("MASDrM1")
            Case "MASLiq"
                arr2 = ws2.Range("MASLiq1")
            Case "MASLiM"
                arr2 = ws2.Range("MASLiM1")
            Case "MASNon"
                arr2 = ws2.Range("MASNon1")
            Case "MASSee"
                arr2 = ws2.Range("MASSee1")
            Case "MASOth1"
                arr2 = ws2.Range("MASOth1")
            Case "MASPre"
                arr2 = ws2.Range("MASPre1")
           
        End Select
        CompletedProductDropDown.List = arr2
'end copy/paste of script here
 
 
End Sub

and this

'attempt to create the "Scripting Dictionary"
Dim Dept As Object
Dim FirstRow As Long
Dim LastRow As Long
Dim i As Long
Dim LastCol As Long
Dim numLins As Long
Dim DataRange As Variant, v As Variant, s As Variant
Set Dept = CreateObject("Scripting.Dictionary")
Dept.comparemode = vbTextCompare
With Sheets("ProductFormulas")
FirstRow = 2
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
DataRange = .Range("B" & FirstRow & ":A" & LastRow).Value
End With
With Dept
    For i = 1 To UBound(DataRange, 1)
        If .exists(DataRange(i, 1)) Then
            .Item(DataRange(i, 1)) = .Item(DataRange(i, 1)) & "," & DataRange(1, 2)
        Else
            .Add DataRange(i, 1), DataRange(i, 2)
        End If
    Next i
End With
With Sheets("CompletedProd")
    If Application.CountA(.Range("1:1")) Then
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Columns("A").Resize(, LastCol).ClearContents
    Else
        LastCol = 1
    End If
    
    i = 0
    For Each v In Dept.keys
        .Range("A1").Offset(, i) = v
        s = Split(Dept.Item(v), ",")
        numLins = Application.Max(numLins, UBound(s) + 1)
        .Range("A1").Offset(1, i).Resize(UBound(s) + 1).Value = Application.Transpose(s)
        i = i + 1
    Next v
    
    With .Range("A1", .Cells(numLins + 1, Dept.Count))
        .SortSpecial Key1:=.Range("A1"), Order1:=xlAscending, Orientation:=xlSortRows
        .Columns.AutoFit
    End With
End With
Set Dept = Nothing
Set DataRange = Nothing
'end of scripting code
'as a result of this, it's probably not necessary to do anythhig else to the "CompletedProd" sheet
'except create it and move it to the end
'the code above should overwrite anything i would have manually created
Set WSD = Worksheets("CompletedProd")
FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
FinalCol = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column

    Sheets("CompletedProd").Select
    Columns("A").Select
    ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A2:A" & FinalRow).Select
    Selection.Name = ("MASApp1")
    Columns("B").Select
    ActiveSheet.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("B2:B" & FinalRow).Select
    Selection.Name = ("MASChm1")
    Columns("C").Select
    ActiveSheet.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("C2:C" & FinalRow).Select
    Selection.Name = ("MASDrM1")
    Columns("D").Select
    ActiveSheet.Range("D:D").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("D2:D" & FinalRow).Select
    Selection.Name = ("MASDry1")
    Columns("E").Select
    ActiveSheet.Range("E:E").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("E2:E" & FinalRow).Select
    Selection.Name = ("MASLiM1")
    Columns("F").Select
    ActiveSheet.Range("F:F").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("F2:F" & FinalRow).Select
    Selection.Name = ("MASLiq")
    Columns("G").Select
    ActiveSheet.Range("G:G").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("G2:G" & FinalRow).Select
    Selection.Name = ("MASNon1")
    Columns("H").Select
    ActiveSheet.Range("H:H").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("H2:H" & FinalRow).Select
    Selection.Name = ("MASOth1")
    Columns("I").Select
    ActiveSheet.Range("I:I").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("I2:I" & FinalRow).Select
    Selection.Name = ("MASPre1")
    Columns("J").Select
    ActiveSheet.Range("J:J").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("J2:J" & FinalRow).Select
    Selection.Name = ("MASSee1")

I should also mention that this last piece of code is in the macro on the "Accept" button i mentioned earlier.



I realize i just posted abunch of code. If any (or all) of this is confusing please let me know and i will try and clarify.

Many thanks in advance.

 

[Mr_Ragweed]

Nevermind. I can gladly/proudly/excitedly say i finally fixed one of my own problems.

I don't know what just happened but suddenly i can read some of the bits of script like they were in plain english. I don't know why, but know it's making tons of sense.

to all who have helped me on my journey. Too bad this isn't a regular part of my job, 'cause i'm enjoyin the heck out of it.

Thanks!

 

[Mr_Ragweed]

Almost forgot, for those of you who actually read this post and the code within. The problem was a bit of conflicting spots where 2 pieces of code were editing the same sheet and changing the named ranges. Another issue was the order in which i ws having the events occur. once i printed a copy of each macro and laid them out chronologically it became visible to me.