Solved

Performance issue with Combo Boxes and filling.

Posted on 2013-06-28
55
259 Views
Last Modified: 2013-10-28
I have a form that loads whit dynamic Comboboxes based off of the number of cells in the PostBackground Tab.  Then it fills the Comboboxes with the Values from the ManBackground tab.

-Once a name is selected from the combo boxes I want the named removed from all comboboxes.  Currently it only removes it from the comboboxes whose .value = ""

- If a name is deleted from the comboboxes I want it added as a selection back to all comboboxes.  It currently does this.

- ISSUES -

1.) The update process takes a fair amount of time after each selection. I have played around with loading the information into an array but had no luck figuring it out.  

2.) Sometimes when a name is selected from the dropdown list and you go to the next dropdown the last name selected will still appear.  However once an additional name has been selected the prior name will no longer show up as a selection.

    -ie.  Combobox1 - selected John, Smith 1
     
   ' I go to Combobox2 - John, Smith 1 still appears BUT when I select a name for Combobox2 "John Smith 2" then

   ' I go to Combobox3  - John Smith 1 and John Smith 2 are no longer available for selection.


Any help on speed and dependability on this would be greatly appreciated!

Here is my current code:

Dim postCount, i, fmSize, t, troopCount As Integer
Dim postCallSign, postDesc, postRO, rosterDate, minManning As String
Dim troopName() As Variant
Dim colTbxs As Collection    'Collection Of Custom Textboxes
Dim lCount As Long


Sub cbFillPost()
'----------Count the number of ComboBoxes there are on the form to cycle through
    Dim cCont As Control
    lCount = 0

    For Each cCont In Me.Controls
        If TypeName(cCont) = "ComboBox" Then
            lCount = lCount + 1
        End If
    Next cCont
    For i = 1 To lCount
        For t = 1 To troopCount
            For Each e In Range((Cells(t, 1)), (Cells(t, 1)))
                With Me.Controls("ComboBox" & i)
                    If Cells(t, 16).Value = 0 Then
                        .AddItem e.Value    '
                        .List(.ListCount - 1, 1) = e.Offset(0, 1).Value
                        .List(.ListCount - 1, 2) = e.Offset(0, 2).Value
                        .List(.ListCount - 1, 3) = e.Offset(0, 3).Value
                        .List(.ListCount - 1, 4) = e.Offset(0, 4).Value
                        .List(.ListCount - 1, 5) = e.Offset(0, 5).Value
                        .List(.ListCount - 1, 6) = e.Offset(0, 6).Value
                        .List(.ListCount - 1, 7) = e.Offset(0, 7).Value
                        .List(.ListCount - 1, 8) = e.Offset(0, 8).Value
                    End If
                End With
            Next e
        Next t
    Next i
End Sub

Private Sub btnExit_Click()
    Sheet4.Activate
    Unload Me
End Sub

Private Sub btnSaveRoster_Click()
'Save UserForm for Roster "fmMakeRoster" to save values to Matrix on btncmd
    Dim sTroopName, sCallSign, sDate As String
    Dim sTroopCount, sDayCount, i, N, d As Integer
    Dim cCont As Control


    '    For Each cCont In Me.Controls
    '        If TypeName(cCont) = "ComboBox" Then
    '            lCount = lCount + 1
    '        End If
    '    Next cCont
    For i = 1 To lCount
        If Me.Controls("Combobox" & i).Value <> "" Then
            Sheet2.Activate
            sTroopCount = Cells(Rows.Count, "A").End(xlUp).Row
            sDayCount = ActiveSheet.UsedRange.Columns.Count
            For N = 1 To sTroopCount
                sTroopName = Me.Controls("ComboBox" & i).Value
                If sTroopName = Cells(N, 6).Value Then
                    For d = 1 To sDayCount
                        If Cells(4, d).Value = rosterDate Then
                            Cells(N, d).Value = Me.Controls("lblCallSign" & i).Caption
                            Exit For
                        End If
                    Next d
                End If
            Next N
        End If
        Application.StatusBar = "Progress: " & i & " of :  " & lCount & "   " & Format(i / lCount, "0%")
    Next i
    Application.StatusBar = False
    Sheet1.Activate
    rosterSendtoWorksheet.CreateRoster
    Unload Me
End Sub



Private Sub Frame1_Click()

End Sub

Private Sub UserForm_Initialize()
    Application.StatusBar = ""
    Application.ScreenUpdating = False
    Sheet6.Activate
    postCount = Cells(Rows.Count, "A").End(xlUp).Row
    'Change Active Sheet to Dashboard to get Date then back to sheet6
    Sheet4.Activate
    rosterDate = Cells(7, 3).Value
    minManning = Cells(22, 5).Value
    lblDate.Caption = "Roster for " & rosterDate & ":"
    lblMinMan.Caption = "Minimum Manning: " & minManning

    lblWPN.Caption = ""
    lblCert.Caption = ""
    lblDL.Caption = ""
    lblK9.Caption = ""

    Sheet6.Activate
    'add hidden box to store name value
    For i = 1 To postCount
        postCallSign = Cells(i, 1).Value
        Set obj = Frame1.Controls.Add("Forms.Label.1")
        obj.Name = "lblnameStore" & i
        obj.Visible = False
        obj.Height = 18
        obj.Left = 380
        obj.Width = 100
        obj.Top = -15 + (30 * i)
        obj.Caption = ""
        obj.Font.Size = 8

    Next i
    'Adds the Post call sign
    For i = 1 To postCount
        postCallSign = Cells(i, 1).Value
        Set obj = Frame1.Controls.Add("Forms.Label.1")
        obj.Name = "lblCallSign" & i
        obj.Height = 18
        obj.Left = 180
        obj.Width = 48
        obj.Top = -15 + (30 * i)
        obj.Caption = postCallSign
        obj.Font.Size = 12
        obj.TextAlign = 2
    Next i
    'Adds the post Description Cell
    For i = 1 To postCount
        postDesc = Cells(i, 4).Value
        Set obj = Frame1.Controls.Add("Forms.Label.1")
        obj.Height = 18
        obj.Left = 234
        obj.Width = 162
        obj.Top = -15 + (30 * i)
        obj.Caption = postDesc
        obj.Font.Size = 12
        obj.TextAlign = 2
    Next i
    'Loads combobox for Troop Selection
    For i = 1 To postCount
        postRO = Cells(i, 2)
        Set obj = Frame1.Controls.Add("forms.combobox.1", "Combobox" & i)
        obj.Height = 15.75
        obj.Left = 12
        obj.Top = -15 + (30 * i)
        fmSize = obj.Top
        obj.Width = 162
        obj.BoundColumn = 2
        obj.TextColumn = 2
        obj.ColumnCount = 8    '7 of 10 curent usage
        obj.ListWidth = 430    'set = to all columnwidhts add
        obj.ColumnWidths = "30; 100; 20; 20; 30; 167; 23; 20;"


        If postRO = "Required" Then
            obj.BackColor = &HFF&
        Else
            obj.BackColor = &HFF00&
        End If
    Next i

    For i = 1 To postCount
    Dim Myarray As Variant
    Myarray = Range(Cells(i, 5), Cells(i, 10)).Value
        'postCallSign = Cells(i, 1).Value
        Set obj = Frame1.Controls.Add("forms.ListBox.1")
        obj.Name = "lbPostRequirments" & i
        obj.Height = 18
        obj.Left = 395
        obj.Width = 200
        obj.Top = -15 + (30 * i)
        obj.ColumnCount = 6
        obj.ColumnWidths = "30; 30; 30; 30; 30; 30"
        obj.List = Myarray
        obj.Font.Size = 9
        obj.BackColor = &H80000004
        obj.Enabled = False
        
    Next i


    ' adds Troop names to each combobox
    Sheet7.Activate
    troopCount = Cells(Rows.Count, "A").End(xlUp).Row
    lblPFD.Caption = "PFD: " & troopCount
    cbFillPost
    Frame1.ScrollHeight = fmSize + 100

    'Check to see if there are enought bodies, if not recall fmusebodies
    If troopCount < minManning Then
        Unload Me
        Dim iRet As Integer
        Dim strPrompt As String
        Dim strTitle As String
        ' Promt
        strPrompt = "You need to add more bodies. Please select Training Days and or Break"
        ' Dialog's Title
        strTitle = "Increase PFD member:"
        'Display MessageBox
        iRet = MsgBox(strPrompt, vbCritical, strTitle)



        fmUseBodies.Show

    End If

    'Option Explicit


    Dim ctlLoop As MSForms.Control
    Dim clsObject As clsObjHandler_MakeRoster
    'Create New Collection To Store Custom Comboboxes
    Set colTbxs = New Collection
    'Loop Through Controls On Userform
    For Each ctlLoop In Me.Controls
        'Check If Control Is A Combobox
        If TypeOf ctlLoop Is MSForms.Combobox Then
            'Create A New Instance Of The Event Handler CLass
            Set clsObject = New clsObjHandler_MakeRoster
            'Set The New Instance To Handle The Events Of Our Combobox
            Set clsObject.Control = ctlLoop
            'Add The Event Handler To Our Collection
            colTbxs.Add clsObject
        End If
    Next ctlLoop
End Sub

Private Sub UserForm_Terminate()
'Destroy The Collection To Free Memory
    Set colTbxs = Nothing
End Sub

Public Sub updateComboBox()    ' removes names
    Dim cCont As Control
    Dim xlCount As Long
    Dim CFT, cboCFT As Integer
    Dim cboTroopName As String
    Sheet7.Activate
    '    For Each cCont In Me.Controls
    '        If TypeName(cCont) = "ComboBox" Then
    '            xlCount = xlCount + 1
    '        End If
    '    Next cCont

    For i = 1 To lCount
        cboTroopName = Me.Controls("Combobox" & i).Text
        If Me.Controls("Combobox" & i).Text = "" Then
            With Me.Controls("ComboBox" & i)
                .Clear
            End With
            For t = 1 To troopCount    'lCount
                For Each e In Range((Cells(t, 1)), (Cells(t, 1)))
                    With Me.Controls("ComboBox" & i)
                        If Cells(t, 16).Value = 0 Then
                            .AddItem e.Value    '
                            .List(.ListCount - 1, 1) = e.Offset(0, 1).Value
                            .List(.ListCount - 1, 2) = e.Offset(0, 2).Value
                            .List(.ListCount - 1, 3) = e.Offset(0, 3).Value
                            .List(.ListCount - 1, 4) = e.Offset(0, 4).Value
                            .List(.ListCount - 1, 5) = e.Offset(0, 5).Value
                            .List(.ListCount - 1, 6) = e.Offset(0, 6).Value
                            .List(.ListCount - 1, 7) = e.Offset(0, 7).Value
                            .List(.ListCount - 1, 8) = e.Offset(0, 8).Value
                        End If
                    End With
                Next e
            Next t
        Else
            Me.Controls("lblnameStore" & i).Caption = Me.Controls("Combobox" & i).Text
            For CFT = 1 To lCount
                For cboCFT = 1 To lCount
                    If Me.Controls("lblnameStore" & cboCFT).Caption = Cells(CFT, 2).Value Then
                        Cells(CFT, 16).Value = 1
                        Cells(CFT, 17).Value = Me.Controls("lblCallSign" & cboCFT).Caption
                        'Exit For
                    End If
                Next cboCFT
            Next CFT
        End If
    Next i
End Sub

Public Sub updateComboBoxAdd()    ' add names back to list names
    Dim cCont As Control
    '    Dim lCount As Long
    Dim CFT, cboCFT As Integer
    Dim cboTroopName As String
    Sheet7.Activate
    '    For Each cCont In Me.Controls
    '        If TypeName(cCont) = "ComboBox" Then
    '            lCount = lCount + 1
    '        End If
    '    Next cCont

    For i = 1 To lCount
        cboTroopName = Me.Controls("lblnameStore" & i).Caption
        If Me.Controls("Combobox" & i).Text <> cboTroopName Then
            Me.Controls("lblnameStore" & i).Caption = ""
            For CFT = 1 To lCount
                If cboTroopName = Cells(CFT, 2).Value Then
                    Cells(CFT, 16).Value = 0
                    Cells(CFT, 17).Value = ""
                    Exit For
                End If
            Next CFT
            With Me.Controls("ComboBox" & i)
                .Clear
            End With
            'updateComboBox
        End If
        updateComboBox
    Next i

    ' load call to add names to roster

    Sheet1.Activate
    'Unload Me
End Sub

Open in new window


I have also included some sample data with the code and form included.
Roster-Combo-Box.xlsm
0
Comment
Question by:Chrispy2811
  • 29
  • 26
55 Comments
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39287185
When I open your wb nothing happens. Should it? If not, how to I get to the point where the form loads the comboboxes?
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39287186
It also looks like I need clsObjHandler_MakeRoster.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39287259
Sorry, I was trying to only post the scrubbed data.  Here is the whole project with all identification information changed.
Matrix-Scrub.xlsm
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39287288
I'm going out for a while in about an hour so I may not be able to do much on this today but I can probably help you.

First of all go to Visual Basic and do Debug|Compile VBA project. When you do (if your code is the same as in the posted workbook) you'll see there are a couple of errors. The one in selectTroop may be part of the problem you are having. In any case in order for me to be better able to help you please give me step by step directions in how to reproduce your two issue.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39287315
Roger that.

As far as reproducing the issues:

-The slow selection is found by the following steps:
- On the Dashboard Sheet
-Click Generate Roster
-This takes the date to the left and checks the Matrix Sheet for individuals who are working/training/break then displays a user form showing the results along with the minimum amount of people needed to post for the day.
-This also takes the FPCON (Normal/Alpha/Bravo/Charlie/Delta) and checks the Post sheet for the post required for the selected FPCON
-The next Form to follow is where you select the names to assign to a post (this is where you will see the results of the slow down the more names you have selected.

- This is the same screen you will see the name removal not working.
-Select the 3rd or 4th name down in the dropdown box and then go to the next dropdown box.  The name will still remain
- Select a name again and go to the next dropdown box, you will see the name selected in the 1st box is now gone.
- However if you select the first name in the dropdown box and then go to another dropdown box the name has been removed.

Does that get you in the right direction?

Thanks again!
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39287330
I'll take a look at it first thing in the morning. (I'm on the Pacific coast of USA).
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39287333
Thanks, I am in Korea so it will be at night here for me. 9am now
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39287346
In the meantime why don't you see if you can fix selectTroop.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39287825
I did not get an error on selectTroop.  Only got two.

1st on a byref argument type mismatch, I had used Dim a, b as String and was trying to pass them both.  Was not aware that "b" was a Variant and not a String.  Changed to Dim a As String, b As String. Fixed.

2nd on a Next x where there was no For Loop.  Commented out the Next x line and there were no further errors.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39288176
I did not get an error on selectTroop.  Only got two...2nd on a Next x where there was no For Loop.
The second error is in selectTroop but no matter, I fixed it.

-The next Form to follow is where you select the names to assign to a post (this is where you will see the results of the slow down the more names you have selected.
After I click 'Generate Roster' and then click 'Continue' on the 'Choose to Use' form I get this
???where apparently I can only select one individual (should I be able to change 'Requirements for post? - I can't) and even when I do that and then click 'Save Roster' I'm shown the 'Duty Roster' sheet which looks unchanged from the last time I saw it. It always shows "Kym Coffin" as the one and only 'NAME' no matter who I pick.  What am I doing wrong?
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39288566
Hum, not sure why it is doing that. I have posted the non-scrubbed version in this post.

You cannot change the requirements on this form.  It is pulled from Post (Sheet2).

The second part about "Kym Coffin" being posted for all boxes is something else I am working on right now.  I didn't realize if all the comboboxes on UserForm2 are not used it will just use the last name selected to fill the rest of the post...
Matrix-24Jun.xlsm
0
 
LVL 45

Assisted Solution

by:Martin Liss
Martin Liss earned 500 total points
ID: 39288630
Okay the following code fixes the slow down. I will see now if I can reproduce and fix problem #2.

Public Sub updateComboBox()    ' removes names
    Dim cCont As Control
    Dim xlCount As Long
    Dim CFT, cboCFT As Integer
    Dim cboTroopName As String
    Sheet7.Activate
    '    For Each cCont In Me.Controls
    '        If TypeName(cCont) = "ComboBox" Then
    '            xlCount = xlCount + 1
    '        End If
    '    Next cCont

    For i = 1 To lCount
        cboTroopName = Me.Controls("Combobox" & i).Text
        If Me.Controls("Combobox" & i).Text = "" Then
            With Me.Controls("ComboBox" & i)
                .Clear
            End With
            For t = 1 To troopCount    'lCount
                For Each e In Range((Cells(t, 1)), (Cells(t, 1)))
                    With Me.Controls("ComboBox" & i)
                        If Cells(t, 16).Value = 0 Then
                            .AddItem e.Value    '
                            .List(.ListCount - 1, 1) = e.Offset(0, 1).Value
                            .List(.ListCount - 1, 2) = e.Offset(0, 2).Value
                            .List(.ListCount - 1, 3) = e.Offset(0, 3).Value
                            .List(.ListCount - 1, 4) = e.Offset(0, 4).Value
                            .List(.ListCount - 1, 5) = e.Offset(0, 5).Value
                            .List(.ListCount - 1, 6) = e.Offset(0, 6).Value
                            .List(.ListCount - 1, 7) = e.Offset(0, 7).Value
                            .List(.ListCount - 1, 8) = e.Offset(0, 8).Value
                        End If
                    End With
                Next e
            Next t
        Else
            Me.Controls("lblnameStore" & i).Caption = Me.Controls("Combobox" & i).Text
            'new
'            For CFT = 1 To lCount
'                For cboCFT = 1 To lCount
'                    If Me.Controls("lblnameStore" & cboCFT).Caption = Cells(CFT, 2).Value Then
'                        Cells(CFT, 16).Value = 1
'                        Cells(CFT, 17).Value = Me.Controls("lblCallSign" & cboCFT).Caption
'                        'Exit For
'                    End If
'                Next cboCFT
'            Next CFT
            Dim FoundName As Range
            With ActiveSheet
            Columns("B:B").Select
            Set FoundName = Selection.Find(What:=Me.Controls("Combobox" & i).Text, After:=ActiveCell, LookIn:=xlValues _
                , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
            If Not FoundName Is Nothing Then
                .Cells(FoundName.Row, 16).Value = 1
                .Cells(FoundName.Row, 17).Value = Me.Controls("lblCallSign" & FoundName.Row).Caption
            Else
                MsgBox "Program error caused perhaps by data being changed during troop selection", _
                       vbCritical + vbOKOnly, "Program Error"
                Exit Sub
            End If
            End With

        End If
    Next i
End Sub

Open in new window




I also suggest however that
You show a dynamic count of the troops selected at the top of fmMakeRoster so the user can tell how many he's selected so far.
Don't color the comboboxes - the text is hard to read especially on the red. Instead add a column on the form to the left of the name that shows "Work", "Training", etc.
Instead of just selecting the first item on the "Choose to Use" form, check as many of the checkboxes as required to at least add up to the "Minimum manning" required.

Also at the bottom of GenerateRoster you have
   
 Sheet4.Activate
    fmMakeRoster.Show

Open in new window

I suggest changing that to
    Sheet4.Activate
    On Error Resume Next
    fmMakeRoster.Show

Open in new window

because I ran into an error at the .Show line when I didn't select enough people.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39288801
I was not able to reproduce problem 2. However in your updateComboBox routine it looks like you are clearing and reloading all the comboboxes each time one of the names is selected as a way of updating the list. It would be a lot faster to use the RemoveItem method of the combobox to remove the name from all the comboboxes. In that way you don't have to reload them on every selection.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39293987
Did you try my code?
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39295157
Sorry, I didn't have much time the past few days to work with this.

The SPEED is AMAZING!

Where can I read about using this code:
 Set FoundName = Selection.Find(What:=Me.Controls("Combobox" & i).Text, After:=ActiveCell, LookIn:=xlValues _
                , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

Open in new window


Also I have included the screen shots of the second issue with names still showing up.
Going Down the roster names removed.Going back up the roster the name still appears.
As for the Dynamic count, I like that Idea and will be adding it.

The Comboboxes are colored Red and Green to show what post are Required at the FPCONs and what post are Optional at the selected FPCONs respectively. I guess a better way to do this would be to color the call sign, or change the text in the combobox.  

The reason I don't auto select all the boxes on Choose to Use form is due to the flight chief having control over who he would like to work if it is an off day or training day.  In the career field I am in reading is always optional so I need to make it so if they just click next it will error on low manning and also force them to chose who they want to work so they cannot say the "Program" made someone work.

Thank you so much for your input! I am open to all suggestions if you have any others.  I think I might be looking at going to Access with this.  It started out as something just for our flight and now it looks like it might get integrated into the squadron for all shops.   More scaling options with Access since I can't use SQL on a Gov. computer.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39295301
If you record a macro using Excel's 'Find' function you'll get similar results to what I did. The main differences are that in the macro you'll see that Excel Finds and Activates the cell whereas I just created a range object for the found cell, and that I substitutes a variable in the 'What:=' parameter.

Somebody here wrote a decent tutorial on Find.

I'll see if I can do anything about problem 2.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39295681
Here's a version of the spreadsheet that won't have problem #2. I rewrote updateCombobox so that the selected name is deleted from all blank comboboxes.

Including that change I made 3 changes altogether each marked with 'new
Matrix-24Jun-1Marty.xlsm
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39296127
It has caused a few errors which I am not sure how to correct I have looked it over but can't seem to work it out.

First is on the fmMakeRoster()
--Public Sub updateComboBox()
Me.Controls("lblnameStore" & gintIndex).Caption = gstrName

Open in new window

 <-- error on gintIndex
     - The reason is lblnameStore starts at 1 and gintIndex starts at 0.  Fixed this way
Me.Controls("lblnameStore" & gintIndex +1 ).Caption = gstrName 

Open in new window

    - This lines all of the names up with the lblnameStore boxes.

Next is on the same form:
 If Not FoundName Is Nothing Then
        .Cells(FoundName.Row, 16).Value = 1
        .Cells(FoundName.Row, 17).Value = Me.Controls("lblCallSign" & gintIndex ).Caption

Open in new window

-----In this instance gintIndex is returning the index value of the Listbox selection and not the listbox (Name)
--> Changed to  
 
If Not FoundName Is Nothing Then
        .Cells(FoundName.Row, 16).Value = 1
        .Cells(FoundName.Row, 17).Value = Me.Controls("lblCallSign" & gintPostIndex).Caption

Open in new window

clsObjHandler_MakeRoster()

Open in new window


-tbxCustom1_Click()
       - added
    
gintPostIndex = Replace(tbxCustom1.Name, "Combobox", "")

Open in new window

-tbxCustom1_KeyUp
    -added
    Select Case KeyCode
        Case 8, 46
    
        Case 127
            fmMakeRoster.updateComboBoxAdd
        Case Else
            KeyCode = 0
        End Select

Open in new window



Do you see anything wrong with this code?  From what I see it fixex the indxe errors and adds all the post to the correct positions in all tabs.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39296637
Even tough you says
"It has caused a few errors which I am not sure how to correct I have looked it over but can't seem to work it out.
it looks like you have fixed all the problems. Is that correct?
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39296868
I am currently trying to fix one more issue. Not sure why but with these updates the re-population of the combo boxes did not work if I delete a name.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39296938
Please give me some more details about the problem and maybe I can help. Also if you'd like my help, please attach your current workbook just in case there are changes you've made that you didn't mention above.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39296999
Martin,

     Thanks so much for the help. I attached the new workbook...

on fmMakeRoster
  - Public Sub updateComboBoxAdd()
     - This is where I am having the problem.  

I have the clsObjHandler calling this command when the KeyCode = 8 or 48 and then if all items in the cbo have been deleted it will call the update Public Sub.

When this sub is called it needs to reload the deleted name and all information back to all the cbo's on the form.

I was trying to use your new FoundName Selection method but am still learning as I am sure you can tell from my code.
Matrix-3Jul13.xlsm
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39297218
The only place I can find where you look at KeyCode = 8 is in the tbxCustom1_KeyUp Sub, so it looks like you are trying to delete a troop name from one of the comboboxes. Why do you want to do that? Also that looks like new code and you have several problems in the code.

In updateComboBoxAdd you are trying to use FoundName but that's not defined for that Sub. It's defined in the other Sub that I rewrote but it is local to that other Sub. Do you understand the scope of variables? In any case you should add a Dim FoundName As Range in updateComboBoxAdd.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39297248
I want be able to delete a person who has been selected because the way it is now.  If you select a name and then go tot he next post and select a name and you noticed you selected a person who cannot work that position you need to be able to change them.

I do understand the scope, I was in the middle of writing it when I got the alert from EE so I just uploaded what I had saved.  

Its is all new code the old code is commented out. I started over when I could not figure out what was going on. I was going to write from the start to the finish to see where the error was.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39297320
Instead of allowing a bad selection to be made, and then trying to undo that selection, why not just prevent it in the first place? You say "you noticed you selected a person who cannot work that position" and that implies that there is code that could be written that would recognize that the person should not be selectable so you could do something like this.


Private Sub tbxCustom1_Click()

    'NEW CODE
    If <condition(s) that should make troop un-selectable> Then
        MsgBox "Troop " & tbxCustom1.Text & " " can not work that position"
        tbxCustom1.ListIndex = -1
    End If

    gstrName = tbxCustom1.Text
    gintIndex = tbxCustom1.ListIndex
    gintPostIndex = Replace(tbxCustom1.Name, "Combobox", "")
    
    fmMakeRoster.updateComboBox
End Sub

Open in new window

0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39297468
I think I might do that along with still allowing them to delete a person, but have it so they need to click a delete button.  This will then all for the cbo to reload only that box.  

The reason I need this is because they will pick a person for a post and then select 10 more people and see...man I need that person with those certifications at this location not that one..

This is one reason for the program.  You have 100+ people a day who can be in 60+ different locations its a big puzzle and sometimes you have to take pieces out to make others fit.

Do you advise against this?
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39297552
Okay I understand why you need to be able to delete.

In talking about your delete button you say "This will then all [allow?] for the cbo to reload only that box". Currently when you selected a troop that troop is removed from all blank comboboxes so won't you need to put the name back in all the blank comboboxes?

I don't advise against what you're doing since I really don't know enough about the situation to  make a judgement like that, but maybe a completely different approach would be better? How about changing it where you have the user make all the selections before doing anything else. In this new process each time a selection was made you'd need to see what the previous selections were (not hard to do) and display an error message if they tried to use the same name twice. And when they click the Save Roster button you can do all the updating of the sheets at one time with no muss or fuss.
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 2

Author Comment

by:Chrispy2811
ID: 39297592
I will have to look at it again tomorrow. I feel you have gone above and beyond helping me. I am going to close this question and if I have any more I will repost.  Its 0130 here and I was up for work at 0430 yesterday... so not much brain function left.  

thanks again!
0
 
LVL 45

Assisted Solution

by:Martin Liss
Martin Liss earned 500 total points
ID: 39297607
Thinking about that idea some more it probably isn't practical because it puts too much responsibility on the user in having to look up and down the list to see, or remember, who he selected before.

So to put back a name in all the blank comboboxes I modified this workbook. It puts the name back in all the blank comboboxes (at the end), but the data isn't complete. You can probably modify the code to add the missing data, but if that's hard to do I'd suggest that you create an array when you first build the data on fmMakeRoster and store all the data for a troop name in that array, and then when you need to restore the name you can get all the data from the array.
Matrix-3Jul13Marty.xlsm
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39299326
Well I tried and failed at using arrays.

My thought process was to have two arrays, One would be all of the names loaded from the start.  Once a name was selected the ROW of the selected value would be moved to usedArray.  Then on the procedure call for the delete/comboboxUpdateAdd I would move the value back to the original myArray and then reload all comboboxes.  

I Have not really used Array's so this is all new to me.  Here is my epic fail.  If you have any quick words of advice to fix I will try it if not I will close the question as is since your original answer helped.

Have a good 4th.
Matrix-3Jul13.xlsm
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39300589
Thanks.

I don't know why you call your attempt an "epic fail" - I think it's a good start. I don't think you need two arrays, just add a "used" flag to MyArray. In any case I put a number of comments in the attached that are all marked with 'Marty. Take a look at them, make whatever changes you see fit, and then let's discuss whatever specific problems you have after that.

You can close this question whenever you like; I'll still be here to help in either case.
Matrix-4Jul13Marty.xlsm
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39300602
BTW You mentioned that you are not familiar with arrays, so let me mention this. If you need to store for example 9 things in an array, the upper boundary should be 8 since unless you change it, the first entry by default is zero.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39300931
I wanted to use only one array but I could not figure out how to get the combobox to reload with only the values where MyArray(i,8) = 0.  That was my original intent due to speed and ease.

Happy 4th of July btw, rained here in Korea all day.. Monsoon Season.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39300934
It's been 95 to 98 here for the last 5 days.

Why do you have to reload the comboboxes? In what situation would you need to do anything more than to remove 1 troop or add 1 troop to each combo?
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39300940
Right, so the intent is when they are selected they will be removed from All combo boxes,

so...

For i = 1 To lCount
        With Me.Controls("Combobox" & i)
             For t = 0 To troopCount - 1
                 If MyArray (t,8) <>1 then
                      .additem
                      marrTroopData(t).str0 = e.Offset(0, 0).Value
                    marrTroopData(t).str1 = e.Offset(0, 1).Value
                    marrTroopData(t).str2 = e.Offset(0, 2).Value
                    marrTroopData(t).str3 = e.Offset(0, 3).Value
                    marrTroopData(t).str4 = e.Offset(0, 4).Value
                    marrTroopData(t).str5 = e.Offset(0, 5).Value
                    marrTroopData(t).str6 = e.Offset(0, 6).Value
                    marrTroopData(t).str7 = t
                    marrTroopData(t).str8 = 0
             Next t
        End With
    Next i

Open in new window


something like this?
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39300945
I'm confused. Are you using my marrTroopData array instead of MyArray or did you think that my code that you posted was involved with "when they are selected they will be removed from All combo boxes"?
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39300952
Sorry if I am reading the code right all the values in the combobox should be loaded into the marrTroopData correct?  If so then I would want to fill the comboboxes from that Array but only when the (x,8) = 0.  does that clear it up?
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39300959
Sorry for the confusion but the only reason I added the marrTroopData was to show you how you could use that one-dimension array instead of the two-dimension MyArray. The code that I added fills that array with the same data as was added to MyData. So in short, you can use either one but I didn't mean for you to use both.

In my opinion using the one-dimension array is easier use but it also has another advantage and that is that when you go to use it, Intellisense will be available to help make sure you are referring to the right field in the array. For example I'm sure you can see below how informative it would be if as I suggested in the code that you changed str0, str1, etc to meaningful names.
Intellisense with marrTroopData
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39300998
Ok I think I have a better understanding now.

So with
ReDim marrTroopData(lCount - 1)
    For i = 1 To lCount
        For t = 0 To troopCount - 1
            For Each e In Range((Cells(t + 1, 1)), (Cells(t + 1, 1)))
                If Cells(t + 1, 16).Value = 0 Then
                    marrTroopData(t).str0 = e.Offset(0, 0).Value
                    marrTroopData(t).str1 = e.Offset(0, 1).Value
                    marrTroopData(t).str2 = e.Offset(0, 2).Value
                    marrTroopData(t).str3 = e.Offset(0, 3).Value
                    marrTroopData(t).str4 = e.Offset(0, 4).Value
                    marrTroopData(t).str5 = e.Offset(0, 5).Value
                    marrTroopData(t).str6 = e.Offset(0, 6).Value
                    marrTroopData(t).str7 = t
                    marrTroopData(t).str8 = 0
                End If
            Next e
        Next t
    Next i

Open in new window


I have loaded every value from the sheet into the MarrTroopData().  I can now Loop through this with something like:

For i = LBound(marrTroopData) To UBound(marrTroopData)
    If marrTroopData.str8 = 0 Then
        'code to add whole row from marrTroopData on i index to MyArray
    End If
Next i
' then call my array to fill the comboboxes
    For i = 1 To lCount
        With Me.Controls("Combobox" & i)
            .List = MyArray
        End With
    Next i

Open in new window


This then allows me to change the marrTroopData str8 = 1 when they are selected from the combobox and then I can recall this code to add them back for available selection in the combobox.

For i = LBound(marrTroopData) To UBound(marrTroopData)
    If marrTroopData.str8 = 0 Then
        'code to add whole row from marrTroopData on i index to MyArray
    End If
Next i
' then call my array to fill the comboboxes
    For i = 1 To lCount
        With Me.Controls("Combobox" & i)
            .List = MyArray
        End With
    Next i

Open in new window


Am I understanding this correctly?

I feel like I should pay you tuition.  I really appreciate the advice. All I know about coding is from trial and error, I am sure that is apparent in my coding :)
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39301087
For i = LBound(marrTroopData) To UBound(marrTroopData)
Why are you checking for str8 = 0 here since all the entries are hard-coded to be 0?
    If marrTroopData.str8 = 0 Then
        'code to add whole row from marrTroopData on i index to MyArray
    End If
Next i
' then call my array to fill the comboboxes
Why are you using MyArray when marrTroopData has the same data (at least it does in the wb I posted)? Again I believe you only need one array, not both.
    For i = 1 To lCount
        With Me.Controls("Combobox" & i)
            .List = MyArray
        End With
    Next i


You can use str8 as you flag equal to 1 to indicate that they have been selected, but would a value like "selected" be better since it's self-documenting?

If this is all trial and error coding you've done quite well!
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39301113
I guess I am just not grasping the Array.

So I only need to use marrTroopData, which is filled on user form 2 activate.

Then I have used it to fill all the initial comboboxes:
For i = 1 To lCount
        With Me.Controls("Combobox" & i)
            .List = marrTroopData
        End With
    Next i

Open in new window


I understand that.

Its the part when I get to Combobox_Click events or the KeyPress Events.

This is when I need to recall marrTroopData.
On the Click event, I will change str8 to "selected" ,

(I cannot use .ListIndex as the key for this as Troop15 ListIndex value will be 14 and then after Troop12 is selected Troop15 ListIndex is now 13. I think I can change this with the BoundColumn index and set it to Column where I set the Array Row number)

How do I then update all the other comboboxes on the form to show the removal of the person?  I can use your original
 For Each cbo In Me.Controls
        If TypeOf cbo Is Combobox Then
            If cbo.Text = "" Then
                cbo.RemoveItem gintIndex
            End If
        End If
    Next

Open in new window


This should work.  But when it comes back to adding the name back to the list.
That is what this code was for:

For i = LBound(marrTroopData) To UBound(marrTroopData)

Why are you checking for str8 = 0 here since all the entries are hard-coded to be 0?
    -- Changed to "selected" or NULL.  
    -- I am checking here for the combobox reload.

     If marrTroopData.str8<> "Selected" Then
        'code to add whole row from marrTroopData on i index to Combobox(i)
          For x = 1 To lCount
               With Me.Controls("Combobox" & i)
                    .AddItem
                    .List(.ListCount - 1,1) = i.offset(0,1).value
                    .List(.ListCount - 1,2) = i.offset(0,2).value
                    .List(.ListCount - 1,3) = i.offset(0,3).value
                    .List(.ListCount - 1,4) = i.offset(0,4).value
                    .List(.ListCount - 1,5) = i.offset(0,5).value
                    .List(.ListCount - 1,6) = i.offset(0,6).value
                    .List(.ListCount - 1,7) = i.offset(0,7).value
                    .List(.ListCount - 1,8) = i.offset(0,8).value
               End With
         Next x
     End If
Next i
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39301140
(I cannot use .ListIndex as the key for this as Troop15 ListIndex value will be 14 and then after Troop12 is selected Troop15 ListIndex is now 13. I think I can change this with the BoundColumn index and set it to Column where I set the Array Row number)
while the listindex would be convenient to use you could just loop through the names and exit when you find a match. At that point the value of your looping variable will be the listindex.

In other words if the names in the array are

Martin
Waldo
Chrispy

then if you are looking for "Waldo"

Dim lngIndex As Long

For lngIndex = 0 to UBound(the array)
    If name-in-the-array = "Waldo" Then
        Exit For
    End If
Next

Open in new window


and lngIndex will be 1 and the's the Index into the array.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39301167
Sub cbFillPost()
'----------Count the number of ComboBoxes there are on the form to cycle through
    Dim TrackTroopCount As Integer
    Dim cCont As Control
    Dim blDimensioned As Boolean
    lCount = 0
    TrackTroopCount = 0
    objProtect.UnrotectAll

    For Each cCont In Me.Controls
        If TypeName(cCont) = "ComboBox" Then
            lCount = lCount + 1
        End If
    Next

    'Marty
    ' Since you are starting at 0 the upper boundry of the
    ' array should be troopcount - 1. Also, unless it's for future
    ' growth, you seem to only need to store 9 elements for
    ' each combobox so the upper boundry should be 8. Please also
    ' see my comment in tbxCustom1_Click()
    '    ReDim MyArray(0 To troopCount, 10)    'As Variant
    ReDim MyArray(0 To troopCount - 1, 8)

    'Marty
    ' This is just a demonstration in the use of the Private Type array
    ReDim marrTroopData(lCount - 1)
    For i = 1 To lCount
        For t = 0 To troopCount - 1
            For Each e In Range((Cells(t + 1, 1)), (Cells(t + 1, 1)))
                If Cells(t + 1, 16).Value = 0 Then
                    marrTroopData(t).str0 = e.Offset(0, 0).Value
                    marrTroopData(t).str1 = e.Offset(0, 1).Value
                    marrTroopData(t).str2 = e.Offset(0, 2).Value
                    marrTroopData(t).str3 = e.Offset(0, 3).Value
                    marrTroopData(t).str4 = e.Offset(0, 4).Value
                    marrTroopData(t).str5 = e.Offset(0, 5).Value
                    marrTroopData(t).str6 = e.Offset(0, 6).Value
                    marrTroopData(t).str7 = t
                    marrTroopData(t).str8 = 0
                End If
            Next e
        Next t
    Next i

    For i = 1 To lCount
        With Me.Controls("Combobox" & i)
            For e = LBound(marrTroopData) To UBound(marrTroopData)
                .AddItem e.Value
                .List(.ListCount - 1, 1) = e.Offset(i, 1).Value
                .List(.ListCount - 1, 2) = e.Offset(i, 2).Value
                .List(.ListCount - 1, 3) = e.Offset(i, 3).Value
                .List(.ListCount - 1, 4) = e.Offset(i, 4).Value
                .List(.ListCount - 1, 5) = e.Offset(i, 5).Value
                .List(.ListCount - 1, 6) = e.Offset(i, 6).Value
                .List(.ListCount - 1, 7) = e.Offset(i, 7).Value
                .List(.ListCount - 1, 8) = e.Offset(i, 8).Value
            Next e
        End With
    Next i
   End Sub

Open in new window

In the above code I am getting Object Required error on this line

.List(.ListCount - 1, 1) = e.Offset(i, 1).Value

I cant get past that to work on the update portion.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39301473
I am now getting

Compile Error
"Only User defined Types Defined In Public Objects Modules Can Be Coerced To Or From A Variant Or Passed To Late bound Functions."

I tried to change the Array to Public Type in its own module and it still gave me the same error.

I reviewed this article but didn't understand how I could change mine to this.
http://www.dreamincode.net/forums/topic/225491-compile-error/
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39302204
Starting with line 46 above I think this is what you want

For i = 1 To lCount
        With Me.Controls("Combobox" & i)
            For e = LBound(marrTroopData) To UBound(marrTroopData)
                .AddItem marrTroopData(e).str0
                .List(.ListCount - 1, 1) = marrTroopData(e).str1
                .List(.ListCount - 1, 2) = marrTroopData(e).str2
                .List(.ListCount - 1, 3) = marrTroopData(e).str3
                .List(.ListCount - 1, 4) = marrTroopData(e).str4
                .List(.ListCount - 1, 5) = marrTroopData(e).str5
                .List(.ListCount - 1, 6) = marrTroopData(e).str6
                .List(.ListCount - 1, 7) = marrTroopData(e).str7
                .List(.ListCount - 1, 8) = marrTroopData(e).str8
            Next e
        End With
    Next i
   End Sub

Open in new window

Let me know if after seeing the above you understand how the array works.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39303137
I think I understand now how to load the array.  
marrtTroopData <-- the array
(e) <-- The row of the array you want to evaluate
   - a single dimension so no need to call different columns like I was (i,1), (i,2) ect...
.strX <-- picking the parts of the string you want to fill the combobox in with.

With this, I assume the bound column is still set the same way?
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39303148
Is the 'bound column" the one that in the combobox you do .AddItem <some string>.? If so then in my code above whatever you put into str0 when you fill the array will be the bound column.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39303221
Its outstanding.  This is great. Last follow up...
Can I make the array available to other objects?? I would like to call up the values from my module that loads the selections into the roster as apposed to printing the array to a sheet and then looping the sheet to post the names.

Here is the final code:
Dim postCount, i, fmSize, t, troopCount As Integer
Dim postCallSign, postDesc, postRO, rosterDate, minManning As String
Dim troopName() As Variant
Dim colTbxs As Collection    'Collection Of Custom Textboxes
Dim lCount As Long
Dim cboNameDelete As Integer
'Marty
' It's almost always better to give variables/arrays a specific
' type and here String will do. Also even though the effect is the same
' you should use Private, so...
'Dim MyArray()
Private MyArray() As String

'New
' Two dimensional arrays can be tricky, but creating a User Defined Type
' like this lets you use a one dimensional array
Private Type TroopData
    ' Change these to descriptive names
    strRank As String
    strName As String
    strSection As String
    strCerts As String
    strK9 As String
    strWpn As String
    strASP As String
    strGOVDL As String
    strArrayIndex As String
    strIsUsed As String
    strPostCallSign As String
End Type
Private marrTroopData() As TroopData
Sub cbFillPost()
'----------Count the number of ComboBoxes there are on the form to cycle through
    Dim TrackTroopCount As Integer
    Dim cCont As Control
    Dim blDimensioned As Boolean
    lCount = 0
    TrackTroopCount = 0
    objProtect.UnrotectAll

    For Each cCont In Me.Controls
        If TypeName(cCont) = "ComboBox" Then
            lCount = lCount + 1
        End If
    Next

    'Marty
    ' Since you are starting at 0 the upper boundry of the
    ' array should be troopcount - 1. Also, unless it's for future
    ' growth, you seem to only need to store 9 elements for
    ' each combobox so the upper boundry should be 8. Please also
    ' see my comment in tbxCustom1_Click()
    '    ReDim MyArray(0 To troopCount, 10)    'As Variant
   ' ReDim MyArray(0 To troopCount - 1, 8)

    'Marty
    ' This is just a demonstration in the use of the Private Type array
    ReDim marrTroopData(troopCount - 1) 'lcount
    For i = 1 To lCount
        For t = 0 To troopCount - 1
            For Each e In Range((Cells(t + 1, 1)), (Cells(t + 1, 1)))
                If Cells(t + 1, 16).Value = 0 Then
                  marrTroopData(t).strRank = e.Offset(0, 0).Value
                    marrTroopData(t).strName = e.Offset(0, 1).Value
                    marrTroopData(t).strSection = e.Offset(0, 2).Value
                    marrTroopData(t).strCerts = e.Offset(0, 3).Value
                    marrTroopData(t).strK9 = e.Offset(0, 4).Value
                    marrTroopData(t).strWpn = e.Offset(0, 5).Value
                    marrTroopData(t).strASP = e.Offset(0, 6).Value
                    marrTroopData(t).strGOVDL = e.Offset(0, 7).Value
                    marrTroopData(t).strArrayIndex = t
                    marrTroopData(t).strIsUsed = 0
                End If
            Next e
        Next t
    Next i

    For i = 1 To lCount
        With Me.Controls("Combobox" & i)
            For e = LBound(marrTroopData) To UBound(marrTroopData)
                .AddItem marrTroopData(e).strRank
                .List(.ListCount - 1, 1) = marrTroopData(e).strName
                .List(.ListCount - 1, 2) = marrTroopData(e).strSection
                .List(.ListCount - 1, 3) = marrTroopData(e).strCerts
                .List(.ListCount - 1, 4) = marrTroopData(e).strK9
                .List(.ListCount - 1, 5) = marrTroopData(e).strWpn
                .List(.ListCount - 1, 6) = marrTroopData(e).strASP
                .List(.ListCount - 1, 7) = marrTroopData(e).strGOVDL
                .List(.ListCount - 1, 8) = marrTroopData(e).strArrayIndex
                .List(.ListCount - 1, 9) = marrTroopData(e).strIsUsed
            Next e
        End With
    Next i
   End Sub


Private Sub btnExit_Click()
    Sheet4.Activate
    Unload Me
    objProtect.ProtectAll

End Sub

Private Sub btnSaveRoster_Click()
'Save UserForm for Roster "fmMakeRoster" to save values to Matrix on btncmd
    Dim sTroopName, sCallSign, sDate As String
    Dim sTroopCount, sDayCount, i, N, d As Integer
    Dim cCont As Control
    objProtect.UnrotectAll
'    Sheet6.Activate
'    Cells.Select
'    Selection.Delete
'    startRow = 1
'    For i = 0 To UBound(marrTroopData)
'       Range("A" & i + startRow).Value = marrTroopData(i).strRank
'        Range("B" & i + startRow).Value = marrTroopData(i).strName
'        Range("C" & i + startRow).Value = marrTroopData(i).strSection
'        Range("D" & i + startRow).Value = marrTroopData(i).strCerts
'        Range("E" & i + startRow).Value = marrTroopData(i).strK9
'        Range("F" & i + startRow).Value = marrTroopData(i).strWpn
'        Range("G" & i + startRow).Value = marrTroopData(i).strASP
'        Range("H" & i + startRow).Value = marrTroopData(i).strGOVDL
'        Range("I" & i + startRow).Value = marrTroopData(i).strPostCallSign
'    Next

    For i = 1 To lCount
        If Me.Controls("Combobox" & i).Value <> "" Then
            Sheet2.Activate
            sTroopCount = Cells(Rows.Count, "A").End(xlUp).Row
            sDayCount = ActiveSheet.UsedRange.Columns.Count
            For N = 1 To sTroopCount
                sTroopName = Me.Controls("ComboBox" & i).Value
                If sTroopName = Cells(N, 6).Value Then
                    For d = 1 To sDayCount
                        If Cells(4, d).Value = rosterDate Then
                            Cells(N, d).Value = Me.Controls("lblCallSign" & i).Caption
                            Exit For
                        End If
                    Next d
                End If
            Next N
        End If
        Application.StatusBar = "Progress: " & i & " of :  " & lCount & "   " & Format(i / lCount, "0%")
    Next i
    Application.StatusBar = False
    Sheet1.Activate
    rosterSendtoWorksheet.CreateRoster (i)
    objProtect.ProtectAll
   Erase marrTroopData
    Unload Me
End Sub

Private Sub UserForm_Terminate()
'Destroy The Collection To Free Memory
    Set colTbxs = Nothing
End Sub


Public Sub updateComboBox()    ' removes names
    objProtect.UnrotectAll
    Dim ArrayIndex As Integer
    Dim cbo As Control
    Dim lngRetVal As Long
    Dim i As Integer
    Me.Controls("lblArray" & gintPostIndex).Caption = gintArray    ' MyArray(gintArray, 10)

    'new - Essentially rewrote this Sub
    '-------------------------added lblnames start at 1 not 0
    marrTroopData(gintArray).strIsUsed = "USED"
    marrTroopData(gintArray).strPostCallSign = Me.Controls("lblCallSign" & gintPostIndex).Caption
    Me.Controls("lblArray" & gintPostIndex).Caption = marrTroopData(gintArray).strArrayIndex
    For Each cbo In Me.Controls
        If TypeOf cbo Is Combobox Then
            If cbo.Text = "" Then
                cbo.RemoveItem gintIndex
            End If
        End If
    Next
End Sub

Public Sub updateComboBoxAdd()    ' add names back to list names
    objProtect.UnrotectAll
    Dim x As Integer, startRow As Integer, ReloadDone As Integer
    x = Me.Controls("lblarray" & gintPostIndex).Caption
    Sheet7.Activate
    cboTroopName = Me.Controls("lblArray" & gintPostIndex).Caption
    'Sets the is used switch back to 0
    For i = LBound(marrTroopData) To UBound(marrTroopData)
        If marrTroopData(i).strArrayIndex = cboTroopName Then
            marrTroopData(i).strIsUsed = ""
            marrTroopData(i).strPostCallSign = ""
            Exit For
            End If
        Next i

        For Each cbo In Me.Controls
            If TypeOf cbo Is Combobox Then
                If cbo.Text = "" Then
                    cbo.Clear
                    'For i = 1 To lCount
                        'With Me.Controls("Combobox" & i)
                            For e = LBound(marrTroopData) To UBound(marrTroopData)
                                If marrTroopData(e).strIsUsed <> "USED" Then
                                    cbo.AddItem marrTroopData(e).strRank
                                    cbo.List(cbo.ListCount - 1, 1) = marrTroopData(e).strName
                                    cbo.List(cbo.ListCount - 1, 2) = marrTroopData(e).strSection
                                   cbo.List(cbo.ListCount - 1, 3) = marrTroopData(e).strCerts
                                    cbo.List(cbo.ListCount - 1, 4) = marrTroopData(e).strK9
                                    cbo.List(cbo.ListCount - 1, 5) = marrTroopData(e).strWpn
                                    cbo.List(cbo.ListCount - 1, 6) = marrTroopData(e).strASP
                                    cbo.List(cbo.ListCount - 1, 7) = marrTroopData(e).strGOVDL
                                    cbo.List(cbo.ListCount - 1, 8) = marrTroopData(e).strArrayIndex
                                    cbo.List(cbo.ListCount - 1, 9) = marrTroopData(e).strIsUsed
                                End If
                            Next e
                        'End With
                    'Next i
                End If
            End If
        Next
        Sheet1.Activate
    End Sub




Private Sub UserForm_Initialize()
    objProtect.UnrotectAll
    Application.StatusBar = ""
    Application.ScreenUpdating = False
    fillpostlist
    Sheet6.Activate
    postCount = Cells(Rows.Count, "A").End(xlUp).Row
    'Change Active Sheet to Dashboard to get Date then back to sheet6
    Sheet4.Activate
    rosterDate = Cells(7, 3).Value
    minManning = Cells(22, 5).Value
    lblDate.Caption = "Roster for " & rosterDate & ":"
    lblMinMan.Caption = "Minimum Manning: " & minManning

    lblWPN.Caption = ""
    lblCert.Caption = ""
    lblDL.Caption = ""
    lblK9.Caption = ""

    Sheet6.Activate

    'add hidden box to Array Location value
    For i = 1 To postCount
        postCallSign = Cells(i, 1).Value
        Set obj = Frame1.Controls.Add("Forms.Label.1")
        obj.Name = "lblArray" & i
        obj.Visible = False
        obj.Height = 18
        obj.Left = 380
        obj.Width = 100
        obj.Top = -15 + (30 * i)
        obj.Caption = ""
        obj.font.Size = 8

    Next i
    'Adds the Post call sign
    For i = 1 To postCount
        postCallSign = Cells(i, 1).Value
        Set obj = Frame1.Controls.Add("Forms.Label.1")
        obj.Name = "lblCallSign" & i
        obj.Height = 18
        obj.Left = 180
        obj.Width = 48
        obj.Top = -15 + (30 * i)
        obj.Caption = postCallSign
        obj.font.Size = 12
        obj.TextAlign = 2
    Next i
    'Adds the post Description Cell
    For i = 1 To postCount
        postDesc = Cells(i, 4).Value
        Set obj = Frame1.Controls.Add("Forms.Label.1")
        obj.Height = 18
        obj.Left = 234
        obj.Width = 162
        obj.Top = -15 + (30 * i)
        obj.Caption = postDesc
        obj.font.Size = 12
        obj.TextAlign = 2
    Next i
    'Loads combobox for Troop Selection
    For i = 1 To postCount
        postRO = Cells(i, 2)
        Set obj = Frame1.Controls.Add("forms.combobox.1", "Combobox" & i)
        obj.Height = 15.75
        obj.Left = 12
        obj.Top = -15 + (30 * i)
        fmSize = obj.Top
        obj.Width = 162
        obj.BoundColumn = 2
        obj.TextColumn = 2
        obj.ColumnCount = 8    '7 of 10 curent usage
        obj.ListWidth = 430    'set = to all columnwidhts add
        obj.ColumnWidths = "30; 100; 20; 20; 30; 167; 23; 20;"


        If postRO = "Required" Then
            obj.BackColor = &HFF&
        Else
            obj.BackColor = &HFF00&
        End If
    Next i

    For i = 1 To postCount
        Dim MyArray As Variant
        MyArray = Range(Cells(i, 5), Cells(i, 10)).Value
        'postCallSign = Cells(i, 1).Value
        Set obj = Frame1.Controls.Add("forms.ListBox.1")
        obj.Name = "lbPostRequirments" & i
        obj.Height = 18
        obj.Left = 395
        obj.Width = 200
        obj.Top = -15 + (30 * i)
        obj.ColumnCount = 6
        obj.ColumnWidths = "30; 30; 30; 30; 30; 30"
        obj.List = MyArray
        obj.font.Size = 9
        obj.BackColor = &H80000004
        obj.Enabled = False

    Next i


    ' adds Troop names to each combobox
    Sheet7.Activate
    troopCount = Cells(Rows.Count, "A").End(xlUp).Row
    lblPFD.Caption = "PFD: " & troopCount

    '-----calls the SUB to fill all Comboboxes ALONG WITH FILLS _ MyArray()
    cbFillPost
    Frame1.ScrollHeight = fmSize + 100

    'Check to see if there are enought bodies, if not recall fmusebodies
    If troopCount < minManning Then
        Unload Me
        Dim iRet As Integer
        Dim strPrompt As String
        Dim strTitle As String
        ' Promt
        strPrompt = "You need to add more bodies. Please select Training Days and or Break"
        ' Dialog's Title
        strTitle = "Increase PFD member:"
        'Display MessageBox
        iRet = MsgBox(strPrompt, vbCritical, strTitle)



        fmUseBodies.Show

    End If

    'Option Explicit


    Dim ctlLoop As MSForms.Control
    Dim clsObject As clsObjHandler_MakeRoster

    'Create New Collection To Store Custom Comboboxes
    Set colTbxs = New Collection
    'Loop Through Controls On Userform
    For Each ctlLoop In Me.Controls
        'Check If Control Is A Combobox
        If TypeOf ctlLoop Is MSForms.Combobox Then
            'Create A New Instance Of The Event Handler CLass
            Set clsObject = New clsObjHandler_MakeRoster
            'Set The New Instance To Handle The Events Of Our Combobox
            Set clsObject.Control = ctlLoop
            'Add The Event Handler To Our Collection
            colTbxs.Add clsObject
        End If
    Next ctlLoop
End Sub

Open in new window


Also is there anyway I can tag you for any future questions I might have? I have another issue I know is going to take some help but I have not gotten to it yet.


Thanks again.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39303239
Just change the definitions of the Private Type and marrTroopData from Private to Public. I forget where they are currently but in order for them to be public they must be in a Module and not in the code for a sheet.

If you want to tag me you could I suppose add a link here to the new question but I should see it anyhow and anything else would be an unfair advantage for me. You could also mention in the new question that I helped you before and that will remind me who you are.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39303255
Ha, unfair advantage.. I just like that you have an idea of what is going on so far.

I added it to a Module and made it a Public Type. The fmMakeRoster works without issue. but when I go to the module rosterSendtoWorksheet and try to use the following code:

For tc = LBound(marrTroopData) To UBound(marrTroopData)
    If marrTroopData(tc).strPostCallSign = postcallsing Then
        troopName = marrTroopData(tc).strName
        troopRank = marrTroopData(tc).strRank
        Exit For
    End If
Next tc

Open in new window


It says MarrTroopData is empty.  I called the Module for the Public Array TroopArray.

So I thought TroopArray.marrTroopData would fix it.. but not the case..
Matrix-6Jul13.xlsm
0
 
LVL 45

Accepted Solution

by:
Martin Liss earned 500 total points
ID: 39303263
You still have Private marrTroopData() As TroopData and as I mentioned above it should be Public and in a module, preferably in the TroopArray module you created.
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39303277
Thank you so much.. still early here I guess..

You have gone above and beyond. Again thank you!

Now to choose which response as the answer..haha
0
 
LVL 2

Author Closing Comment

by:Chrispy2811
ID: 39303280
Marty was AMAZING. He was always there to help and I feel he went above and beyond here.  I wish I could give him more points.  Thanks again!
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39303289
You're welcome and I'm glad I was able to help. BTW I did get extra points (from EE) because you didn't get help right away and so your question fell into the "Neglected" category.

Marty - MVP 2009 to 2013
0
 
LVL 2

Author Comment

by:Chrispy2811
ID: 39605561
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

A2 = A1 That kind of cell reference is relative.  If you copy it from A2 to B2, then B2 will get this: B2 = B1 That's all fine and good, but if you then insert a new row above row 2, you'll find: A3 = A1 B3 = B1 This is intentional. …
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now