Performance issue with Combo Boxes and filling.

When I open your wb nothing happens. Should it? If not, how to I get to the point where the form loads the comboboxes?

It also looks like I need clsObjHandler_MakeRoster.

Sorry, I was trying to only post the scrubbed data.  Here is the whole project with all identification information changed.
Matrix-Scrub.xlsm

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.

Roger that.

As far as reproducing the issues:

-The slow selection is found by the following steps:

- This is the same screen you will see the name removal not working.

Does that get you in the right direction?

Thanks again!

I'll take a look at it first thing in the morning. (I'm on the Pacific coast of USA).

Thanks, I am in Korea so it will be at night here for me. 9am now

In the meantime why don't you see if you can fix selectTroop.

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.

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?

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

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.

Did you try my code?

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)

Select allOpen in new window

Also I have included the screen shots of the second issue with names still showing up.

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.

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.

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

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

Select allOpen 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 

Select allOpen 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

Select allOpen 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

Select allOpen in new window

clsObjHandler_MakeRoster()

Select allOpen in new window

-tbxCustom1_Click()
       - added

    
gintPostIndex = Replace(tbxCustom1.Name, "Combobox", "")

Select allOpen in new window

-tbxCustom1_KeyUp
    -added

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

Select allOpen 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.

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?

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.

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.

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

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.

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.

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

Select allOpen in new window

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?

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.

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!

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

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

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.

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.

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?

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

Select allOpen in new window

something like this?

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"?

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?

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.

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

Select allOpen 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

Select allOpen 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

Select allOpen 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 :)

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!

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

Select allOpen 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

Select allOpen 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

(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

Select allOpen in new window

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

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

Select allOpen 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.

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/

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

Select allOpen in new window

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

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?

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.

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

Select allOpen 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.

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.

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

Select allOpen 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

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

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!

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

Marty,

Hope you can help me on this question!!

https://www.experts-exchange.com/questions/28278870/VBA-formatting-from-Array.html

Thanks so much!