Excel VBA Userform option button starts a loop that searches worksheet and populates listbox on userform

[silvertyphoon1]

I have a workbook that contains a few lookup sheets and a userform. The userform has 2 option buttons and a listbox on the form as well as a create new button. When you click on an option the listbox should populate with a specific list of items found on a lookup worksheet in the same workbook. When the user selects the item the want from the list box and click create new, a new worksheet with the same of the item is created. The lookup sheet is 2 columns on it, column A is an item code and column B is an item. The usercodes are specific to the type of item so an example would be:<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o> </o>
1005 Cups<o></o>
1006 Plates<o></o>
2001 Towels<o></o>
2003 Table Cloth<o></o>
<o> </o>
The sequence should go like this if possible, the user opens the form via a button on a worksheet. The form opens with a blank list box and two option buttons one labled Serving and another labled Setup. when a user selects for instance serving as an option, a loop searches all items on the lookup sheet for items starting with the number "1". It then puts these items on the listbox. When a user selects for instance cups and hits create new a new worksheet is created titled Cups. I would like to be able to add new items to the item list by typing a code and item name on my lookup sheet at the end of the current list. I would like if possible for the lookup list to take my item and sort it automatically by number so that the form will still work... Thank you!<o></o>

 

[mikerickson]

What code do you have so far?

 

[mikerickson]

I would like to be able to add new items to the item list by typing a code and item name on my lookup sheet at the end of the current list. I would like if possible for the lookup list to take my item and sort it automatically by number so that the form will still work...

Up until this point in the OP, the other desiderata relate directly to the userform.

Is the user going to add items directly to the worksheet (most users find this option more intuitive)
or through this userform?
Do you want the cells in the worksheet to be sorted on the worksheet, or do you want them sorted only when the listbox is filled?
Do your data columns have headers?

What if there is already a sheet named "Cups", do you want "Cups(2)" or ...?
Do you want the userform to go away after making the new sheet or should it remain open?

 

[silvertyphoon1]

Thanks for the quick response,
The user will add new items to the lookup sheet directly and not through the userform. The idea was to sort the new item entered directly on the lookup sheet once your finished typing it at the bottom of the list. Also sorted when the opt button is selected and it is populated on the userform. Data columns have headers labeled code on A1 and Type on B1.
If cups already exists then add cups(2) as mentioned. Userform will go away after the new sheet has been created. Thanks for all of the questions, I guess I should have thought of this more fully. Well there it is at least what I'm trying to do. I'm not sure as to what code should go there at all really other then the basics of course.

 

[diddi]

post the code

 

[mikerickson]

If you have a userform with three option buttons (named OptionButton1, OptionButton2, OptionButton3) one list box (ListBox1) and two CommandButtons (butNewSheet and butClose) you could put this code in the userform's code module.

Dim datarange As Range

Sub ListBox1Fill()
    Dim oneCell As Range
    Dim criteriaStr As String
    With ThisWorkbook.Sheets("Sheet1").Columns(1)
        Set datarange = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    
    With datarange
        .Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
    End With
    
    With ListBox1
        .Clear
        criteriaStr = OptionIndicatedFilter
        For Each oneCell In datarange
            If CStr(oneCell.Value) Like criteriaStr Then
            .AddItem CStr(oneCell)
            .List(.ListCount - 1, 1) = CStr(oneCell.Offset(0, 1).Value)
            .List(.ListCount - 1, 2) = CStr(oneCell.Row)
            End If
        Next oneCell
    End With
End Sub

Function OptionIndicatedFilter() As String
    Dim selectedOptButton As Long
    With Me
        selectedOptButton = CLng(.OptionButton1.Value) + 2 * CLng(.OptionButton2.Value) + 3 * CLng(.OptionButton3.Value)
    End With
    OptionIndicatedFilter = "*"
    Select Case -selectedOptButton
        Case 0: OptionIndicatedFilter = "*": Rem show all
        Case 1: OptionIndicatedFilter = "1*": Rem show begins with "1"
        Case 2: OptionIndicatedFilter = "2*": Rem show begins with "2"
        Case 3: OptionIndicatedFilter = "[!12]*": Rem begins with other than 1 or 2
        Case Else: OptionIndicatedFilter = "*"
    End Select
End Function

Private Sub butNewSheet_Click()
    With ListBox1
        If .ListIndex <> -1 Then
            Call makeNewSheet(datarange.Parent, .List(.ListIndex, 1))
        End If
        .ListIndex = -1
    End With
End Sub

Private Sub OptionButton1_Click()
    Call ListBox1Fill
End Sub
Private Sub OptionButton2_Click()
    Call ListBox1Fill
End Sub
Private Sub OptionButton3_Click()
    Call ListBox1Fill
End Sub

Private Sub butCancel_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    With ListBox1
        .ColumnCount = 3
        .ColumnWidths = ";;0"
    End With
    Call ListBox1Fill
End Sub

The workbook name and sheet in ListBox1Fill routing should be altered to fit you situation. Also the correspondance between the OptionButtons and the criteria strings in OptionIndicatedFilter should be adjusted to your taste.
I've found that working on other comonents is best done from a normal module, so this goes in a normal module. You could try it in the userform's code module to see if that's stable on your machine.

Function makeNewSheet(addAfter As Worksheet, sheetName As String) As Boolean
    Dim nameExists As Boolean
    Dim copyindex As Long, suffixStr As String
    Dim newName As String
    sheetName = Proper(Application.Trim(sheetName))
    Do
        copyindex = copyindex + 1
        If copyindex = 1 Then
            newName = sheetName
        Else
            newName = sheetName & "(" & CStr(copyindex) & ")"
        End If
        nameExists = False
        On Error Resume Next
        nameExists = (addAfter.Parent.Sheets(newName).Name = newName)
        On Error GoTo 0
    Loop Until Not nameExists
    
    addAfter.Parent.Worksheets.Add(after:=addAfter).Name = newName
End Function

This needs error handling added to handle illegal characters and other possible problems.

 

[mikerickson]

I made a mistake in the sort part of this sub.

Sub ListBox1Fill()
    Dim oneCell As Range
    Dim criteriaStr As String
    With ThisWorkbook.Sheets("Sheet1").Columns(1)
        Set datarange = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    
    [COLOR="Red"]With datarange
        With Range(.EntireColumn.Cells(1,1), .Cells).EntireRow
            .Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
         End With
    End With[/COLOR]

    With ListBox1
        .Clear
        criteriaStr = OptionIndicatedFilter
        For Each oneCell In datarange
            If CStr(oneCell.Value) Like criteriaStr Then
            .AddItem CStr(oneCell)
            .List(.ListCount - 1, 1) = CStr(oneCell.Offset(0, 1).Value)
            .List(.ListCount - 1, 2) = CStr(oneCell.Row)
            End If
        Next oneCell
    End With
End Sub