none
Using Concatentated List Box value for Dict search RRS feed

  • Question

  • Hi All

    I have a list box which has a Value of "GOL - Go Live within it."

    Using the below code, I take the value, build an array using a range and then filter to outsort the blanks.

    This code used to work as I used to only use a 3 char status, eg GOL but now I have to use the whole string.

    As the rest of my code refers to the list address (f), any idea how I can get it to work with a concatentaed list box value, i.e. somewhere I have to reassign (f) to be the concatenated value.

      'FUNCTIONAL MILESTONE EXTRACTION
        'Data range
        Set rngdata = Range("AG2", Range("AG" & Rows.Count).End(xlUp))
        
        'Read data into an Array
        v = rngdata.Value
       
        'add the selected ListBox items to a Dictionary object
        Set Dict = CreateObject("Scripting.Dictionary")
        Dict.CompareMode = 1 'Text compare mode
        With FunList
            For f = 0 To FunList.ListCount - 1
                If .Selected(f) Then
               
                Dict(.List(f)) = f
                End If
            Next f
          
        End With
       
       
        'Test each item in the data array if it exists in the Selected items Dictionary
        For f = LBound(v) To UBound(v)
            'Items that that are not selected are cleared (vbNullstring) from the data array
       

            If Not Dict.Exists(v(f, 1)) Then v(f, 1) = vbNullString
        Next f
           
        'Write the data array back to the data range
       
        rngdata = v
       
        'Delete the rows of the blank cells in the data range
        ActiveSheet.Range("$A$1:$AM$" & Rows.Count).AutoFilter Field:=33, Criteria1:="="
        Rows("2:" & ActiveSheet.UsedRange.Rows.Count).Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.Range("$A$1:$AM$" & Rows.Count).AutoFilter Field:=33
           

    Wednesday, July 17, 2013 5:22 AM

All replies

  • This will do the deletion/saving based on the first "word" of the selected value "GOL" in your example:

    Sub TestMacro()
    Dim Dict As Scripting.Dictionary
    Dim v As Variant
    Dim rngData As Range
    Dim f As Integer

      'FUNCTIONAL MILESTONE EXTRACTION
        'Data range
        Set rngData = Range("AG2", Range("AG" & Rows.Count).End(xlUp))
         
        'Read data into an Array
        v = rngData.Value
        
        'add the selected ListBox items to a Dictionary object
        Set Dict = New Scripting.Dictionary
        Dict.CompareMode = 1 'Text compare mode
        With Activesheet.FunList
            For f = 0 To .ListCount - 1
                If .Selected(f) Then
                Dict(Split(.List(f), " ")(0)) = f
                End If
            Next f
           
        End With
        
        
        'Test each item in the data array if it exists in the Selected items Dictionary
        For f = LBound(v) To UBound(v)
            'Items that that are not selected are cleared (vbNullstring) from the data array
            If Not Dict.Exists(Split(v(f, 1), " ")(0)) Then v(f, 1) = vbNullString
        Next f
            
        'Write the data array back to the data range
        
        rngData = v
               
    End Sub

    Wednesday, July 17, 2013 3:32 PM
  • Hi

    Thanks for the help Bernie, changed the code and now receive a subscript out of range error on the following line on the first pass :-

     If Not Dict.Exists(Split(v(f, 1), " ")(0)) Then v(f, 1) = vbNullString

    Cheers

    Sean

    Wednesday, July 17, 2013 10:43 PM
  • Thanks Bernie

    I replaced this line :

    If Not Dict.Exists(Split(v(f, 1), " ")(0)) Then v(f, 1) = vbNullString

    with my original

    If Not Dict.Exists(v(f, 1)) Then v(f, 1) = vbNullString

    and it worked, your first split created the string so it didnt need any more splitting.

    Thats my take on it, but I am a noob at this.

    Thanks again

    Sean

    Wednesday, July 17, 2013 11:00 PM