Add Item to Combox in Userform

[Craig2010]

Hi All,

I've searched here and googled but to no avail. I'm not to savvy on this VBA stuff but have fumbled around and created a Userform with a ComboBox and several other fields in an Excel Workbook. The ComboBox gets its list of Customer names from a range in a worskeet.
=OFFSET(Customers!$A$3,0,0,COUNTA(Customers!$A:$A),1)
What I would like to do is that if a name is not in the list that the user can add the name to the ComboBox by way of some sort of Subform that would pop up if they try to enter a name not in the list? This subform would then update the Range that the ComboBox uses and the user can choose the new name from the ComboBox and continue adding other data in the rest of the UserForm fields...help please...
<input id="gwProxy" type="hidden"><!--Session data--><input *******="jsCall();" id="jsProxy" type="hidden">

 

[tryagain]

Private Sub ComboBox1_AfterUpdate()
Set sh = Sheets("Sheet1")
rw = sh.Cells(1000, 1).End(xlUp).Offset(1, 0).Row
If Application.CountIf(sh.Range("A1:A" & rw), ComboBox1) = 0 Then
msg = "Do u want to add "
Title = "Ur input dosent match ur target"
x = MsgBox(msg & Me.ComboBox1.Value & " ?", vbYesNo, Title)
End If
If x = 6 Then
sh.Cells(rw, "A") = Me.ComboBox1.Value
Me.ComboBox1.RowSource = sh.Name & "!A1:A" & rw
End If
End Sub

Private Sub UserForm_Initialize()
Set sh = Sheets("Sheet1")
rw = sh.Cells(1000, 1).End(xlUp).Offset(1, 0).Row
Me.ComboBox1.RowSource = sh.Name & "!A1:A" & rw
End Sub

 

[Craig2010]

Thanks for the reply. Somehow I managed to get that to work. Much appreciated. Is there a way I could get the source data for the ComboBox sorted A-Z after the addition of a new name?


<input id="gwProxy" type="hidden"><!--Session data--><input *******="jsCall();" id="jsProxy" type="hidden">

 

[tryagain]

y try

Set sh = Sheets("Sheet1")
rw = sh.Cells(1000, 1).End(xlUp).Offset(1, 0).Row
If Application.CountIf(sh.Range("A1:A" & rw), ComboBox1) = 0 Then
msg = "Do u want to add "
Title = "Ur input dosent match ur target"
x = MsgBox(msg & Me.ComboBox1.Value & " ?", vbYesNo, Title)
End If
If x = 6 Then
sh.Cells(rw, "A") = Me.ComboBox1.Value
sh.Range("A1:A" & rw + 1).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Me.ComboBox1.RowSource = sh.Name & "!A1:A" & rw
End If
End Sub

 

[tryagain]

ups missed first line
Private Sub ComboBox1_AfterUpdate()

 

[diddi]

i often use comboboxes with more than 1 column and use this little sub to sort them out. you can sort by any of the columns in the combobox or listbox if you want.

in your userform, add these lines after the combobox or listbox has been populated...

    Dim TempArray

    .....stuff here

    TempArray = ComboBox1.List
    SortColumnUp TempArray, 1, 4          ' sort the 2nd column of a 4 column combobox
    Combobox1.List=TempArray

    TempArray = ListBox1.List
    SortColumnUp TempArray, 3, 7          ' sort the 4th column of a 7 column listbox
    ListBox1.List=TempArray

    TempArray = ComboBox1.List
    SortColumnUp TempArray, 0, 1          ' sort the 1st column of a 1 column combobox
    Combobox1.List=TempArray

and in the modules area put this sub. it can be reused over and over

Sub SortColumnUp(myArray As Variant, ColNum As Integer, NumCols As Integer)

' myArray is the 2d array to be sorted
' ColNum is the sort column (base 0)
' NumCols is the number of columns in the array

    Dim tempi As String, tempj As String
    NumCols = NumCols - 1

    For i = 0 To UBound(myArray, 1) - 1
        For j = i + 1 To UBound(myArray, 1)
            tempi = myArray(i, ColNum)
            tempj = myArray(j, ColNum)
            If tempi > tempj Then
                For col = 0 To NumCols
                    stemp = myArray(i, col)
                    myArray(i, col) = myArray(j, col)
                    myArray(j, col) = stemp
                Next
            End If
        Next j
    Next i
End Sub

 

[Craig2010]

Hi Again..I can see what that code is trying to do but I get a run time error and this code is highlighted in yellow, I',m not savvy enought to fix it.

sh.Range("A1:A" & rw + 1).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

is there something I need to change to make it work with my workbook/userform?

Cheers
<input id="gwProxy" type="hidden"><!--Session data--><input *******="jsCall();" id="jsProxy" type="hidden">

 

[diddi]

post all the code in your userform

start with [code.] (but dont include the .)

your code here


and finish with [/code.] (no . again)

that puts your stuff in a code box =)

 

[tryagain]

is A1 ur first celle in ur sourse ?
if not change in: sh.Range("A1:A" & rw + 1).Sort Key1:=Range("A1")

 

[Craig2010]

Here is the code, probably very ugly I'm sure but I have been taking biys and pieces from anywhere i see something like what I am tryng to do. Disregard the text boxes and labels references as they are just for data and progressive calculations.

Private Sub ADD_Click()
Dim LastRow As Object
        Set LastRow = Sheets("Player Action").Range("A65536").End(xlUp)
        
    With LastRow
        .Offset(1, 0) = ComboBox1.Text
        .Offset(1, 1) = DTPicker1.Value
        .Offset(1, 2) = BUYIN.Value
        .Offset(1, 3) = WINLOSS.Value
        
        'clear the data
Me.ComboBox1.Value = ""
Me.BUYIN.Value = ""
Me.WINLOSS.Value = ""
Me.ComboBox1.SetFocus


Dim ws As Worksheet
Set ws = Worksheets("Player Action")

ws.Cells(5, 7).Value = Me.TextBox1.Value
ws.Cells(5, 8).Value = Me.TextBox2.Value
ws.Cells(5, 9).Value = Me.DTPicker1.Value

Label1.Caption = Sheet1.Range("g6").Value
Label2.Caption = Sheet1.Range("h6").Value
Label3.Caption = Sheet1.Range("g7").Value
Label4.Caption = Sheet1.Range("h7").Value
    End With

End Sub

Private Sub ComboBox1_AfterUpdate()
Set sh = Sheets("Players")
rw = sh.Cells(1000, 1).End(xlUp).Offset(1, 0).Row
If Application.CountIf(sh.Range("A1:A" & rw), ComboBox1) = 0 Then
msg = "Do u want to add "
Title = "Ur input dosent match ur target"
x = MsgBox(msg & Me.ComboBox1.Value & " ?", vbYesNo, Title)
End If
If x = 6 Then
sh.Cells(rw, "A") = Me.ComboBox1.Value
[COLOR=Blue]sh.Range("A1:A" & rw + 1).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal[/COLOR]
Me.ComboBox1.RowSource = sh.Name & "!A1:A" & rw
End If
End Sub

Private Sub UserForm_Initialize()
Set sh = Sheets("Players")
rw = sh.Cells(1000, 1).End(xlUp).Offset(1, 0).Row
Me.ComboBox1.RowSource = sh.Name & "!A3:A" & rw
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

The Blue text is where I get a run time error when i try and add a new new name to the ComboBox...it works without that piece of code in it there. just doesn't sort the Combo list...
Cheers
<input id="gwProxy" type="hidden"><!--Session data--><input *******="jsCall();" id="jsProxy" type="hidden">