Pre-select items in a list box through VBA

hrm1220 · Mar 8, 2008

I'm trying to preselect (or make the checkbox=true) in a combolist in Excel 2003 through VBA. This is due to the fact that 204 items are the normal selected items. I wanted to provide the flexibility to the user to either select or remove additional items.

Here's the code I have so far and the line with "lstStep_List.List(i) = True" is where it breaks

Code:

Private Sub PopulateListbox()
Cells.Select
Selection.EntireColumn.Hidden = False
Range("A1").Select
Selection.End(xlToRight).Select
endcol = ActiveCell.Column
Range("A1").Select
startrow = ActiveCell.Address
NumSteps = 0
Do While ActiveCell.Value <> ""
NumSteps = NumSteps + 1
ActiveCell.Offset(0, 1).Select
Loop
Range(startrow).Select
i = ActiveCell.Column
c = i
Do While i < NumSteps + c
If i < NumSteps + c Then
    lstStep_List.AddItem (Cells(ActiveCell.Row, i).Value)
    
    If Application.VLookup(Cells(ActiveCell.Row, i).Value, Schedule_Views.Range("a1:b260"), 2, False) = "Hide Column" Then
   [b] lstStep_List.List(i) = True[/b] "THIS IS WHERE IT BREAKS"
    
    End If
    i = i + 1
 End If
Loop
End Sub

thx for your help

SkipVought · Mar 8, 2008

How about this...

Code:

Private Sub PopulateListbox()
    Dim r As Range, c As Range, i As Integer
    
    i = 0
    lstStep_List.Clear
    For Each r In Range([A1], [A1].End(xlDown))
        For Each c In Range([A1], [A1].End(xlToRight))
            lstStep_List.AddItem (Cells(r.Row, c.Column).Value)
            If Application.VLookup(Cells(r.Row, c.Column).Value, Schedule_Views.Range("a1:b260"), 2, False) = "Hide Column" Then
                lstStep_List.Selected(i) = True '"THIS IS WHERE IT BREAKS"
             Else
                lstStep_List.Selected(i) = False '"THIS IS WHERE IT BREAKS"
            End If
            i = i + 1
        Next
    Next
    
End Sub

Skip,
_{I'll be dressed to the nines this week, as I go to have my prostatectomy...

Because, if I'm gonna BE impotent, I want to LOOK impotent!}

hrm1220 · Mar 8, 2008

THANK YOU. That worked perfectly.

hrm1220 · Mar 10, 2008

ok. I have an additional question my cusomers asked if they could select the starting column to start the list (wanted it to be more flexible if they used for a different file).

This is what i've come up with so far to start the selection of the cell to start:

Code:

Option Explicit
Public Schedule
Public Construction
Public Customview
Public startheader


Private Sub custom()

Set startheader = Application.InputBox( _
    prompt:="Select a cell", Type:=8)
'Inputboxvalue = InputBox("Input the cell of your beginning headers", , A1,)
On Error GoTo Error_Handler
    Range(startheader.Address).Select
    
    Customview = True
    frm_Custom_Views.Show
    Workbooks("CustomViews.XLA").IsAddin = True
    ActiveSheet.Unprotect
Exit Sub
Error_Handler:
    MsgBox ("Macro Failed to complete")
End Sub

and this code is to populate the list they can choose from to hide their columns:

Code:

Private Sub UserForm_Initialize()
    PopulateListbox
End Sub


Private Sub PopulateListbox()
Dim r As Range, c As Range, i As Integer
Dim strstep As String
Dim startheader As Range
Range(startheader).Select
Selection.End(xlToRight).Activate
endcol = ActiveCell.Column

i = 0
lstStep_List.Clear
    For Each c In Range(startheader.Address, startheader.End(xlToRight))

    lstStep_List.AddItem (Cells(1, c.Column).Value)
If Schedule = True Then
    If Application.VLookup(Cells(1, c.Column).Value, Schedule_Views.Range("a1:b260"), 2, False) = "Hide Column" Then
    lstStep_List.Selected(i) = True
    Else: lstStep_List.Selected(i) = False
    End If
ElseIf Construction = True Then
    If Application.VLookup(Cells(1, c.Column).Value, Construction_Views.Range("a1:b260"), 2, False) = "Delete" Then
    lstStep_List.Selected(i) = True
    Else: lstStep_List.Selected(i) = False
    End If
End If
    If i = endcol - 1 Then
    x = x + 1
    End If
    i = i + 1 + x
    Next

End Sub

for some reason I can't get the "startheader" value to show up in the "PopulateListbox" module.

Can you tell me where in my code I screwed up.

Thx for your help

SkipVought · Mar 10, 2008

startheader IS a range

Code:

startheader.Select

startheader is defined as a GLOBAL variable

Code:

Private Sub PopulateListbox()
Dim r As Range, c As Range, i As Integer
Dim strstep As String
[s]Dim startheader As Range[/s]
'what is endcol for???

For Each c In Range(startheader, startheader.End(xlToRight))

Skip,
_{I'll be dressed to the nines this week, as I go to have my prostatectomy...

Because, if I'm gonna BE impotent, I want to LOOK impotent!}

hrm1220 · Mar 10, 2008

thx for this. The endcol is redundant and so I removed it. the other issue I have is that I was now asked if they could save their custom views.

The code now looks like:

Code:

Private Sub custom()
Dim endcol, i, a, space, lastspace

 Workbooks("Customviews.xla").IsAddin = True
Set startheader = Application.InputBox( _
    prompt:="Select a cell", Type:=8)
    msg = MsgBox("Do you want to save this view?", vbYesNo)
    If msg = 6 Then
    startheader.Select
    Selection.End(xlToRight).Select
    endcol = ActiveCell.Column
    Newsheet = ActiveSheet.Name
    Range(Cells(startheader.Row, startheader.Column), Cells(startheader.Row, endcol)).Select
    Selection.Copy
    Workbooks("Customviews.xla").IsAddin = False
    Sheets.Add
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveSheet.Name = Newsheet
    i = ActiveSheet.Index
    Newsheetname = Split(Newsheet, " ")
    ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Worksheets(i)).Name = Newsheetname(0)
    Workbooks("Customviews.xla").IsAddin = True
    End If
On Error GoTo Error_Handler
    Range(startheader.Address).Select
    frm_Custom_Views.Show
    Workbooks("CustomViews.XLA").IsAddin = True
    ActiveSheet.Unprotect
    Customview = True
    
    
     Workbooks("Customviews.xla").IsAddin = True
Exit Sub
Error_Handler:
    MsgBox ("Macro Failed to complete")
End Sub

I'm having issues with the VBProject rename " ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Worksheets(i)).Name = Newsheetname(0)
"

and I'm trying to take the columns they've selected to hide in the follwoing code:

Code:

Private Sub cmd_StepAccept_Click()
    Dim intListCount As Integer
    Dim intSelectedCount As Integer
    Dim varSelected() As Variant
    Dim i, z, a, n, x, c As Integer
    Dim strstep As String
    Dim txtname As String
    Dim countcol(1)
    Dim stepcount, product, prodnum, startcol

 Range("A1").Select
   
    Do While ActiveCell.Value <> ""
    ActiveCell.Offset(0, 1).Select
    Loop
    rng_col_end = ActiveCell.Column - 1
    Range("A1").Select

    c = 0
    intListCount = lstStep_List.ListCount - 1
    intSelectedCount = 0



For i = 0 To intListCount
        If lstStep_List.Selected(i) = True Then
         strstep = lstStep_List.List(i)
         If c = 0 Then
         txtname = strstep
         c = 1
         Else
         txtname = strstep & ", " & txtname
         End If
         If msg = 6 Then
         Newsheetname.Cells.Find(strstep).Offset(0, 1).Value = "Hide Column"
         End If
         If Construction = True Then
            Cells.Find(strstep).Activate
            Columns(ActiveCell.Column).Select
            Selection.Delete Shift:=xlToLeft
            Else:
             Cells.Find(strstep).Activate
            Columns(ActiveCell.Column).Select
            Selection.EntireColumn.Hidden = True
            
         End If
        End If
  Next i
 ' If Schedule = True Then
    Unload frm_Custom_Views
    
End Sub

and I'm hoping where it states that after "If msg=6" statement it will add the "Hide Column" information in the add-in.

Thx again for your help

SkipVought · Mar 10, 2008

Code:

    ActiveWorkbook.Worksheets(i).Name = Newsheetname(0)

Skip,
_{I'll be dressed to the nines this week, as I go to have my prostatectomy...

Because, if I'm gonna BE impotent, I want to LOOK impotent!}

hrm1220 · Mar 10, 2008

Skip thanks for that, but I was trying to name the vbproject to match the sheet name so I could reference this in the "sub Accept()" module.

SkipVought · Mar 11, 2008

Huh? Please explain?

Skip,
_{Have you heard that the roundest knight at King Arthur's round table was...

Sir Cumference!}

hrm1220 · Mar 11, 2008

sorry about that. I'm trying to rename the sheet CodeName to match the name of the sheet so I can reference the sheet CodeName in the rest of the code.

SkipVought · Mar 11, 2008

Code:

    ActiveWorkbook.Worksheets(i).CodeName = Newsheetname(0)

Skip,
_{Have you heard that the roundest knight at King Arthur's round table was...

Sir Cumference!}

hrm1220 · Mar 11, 2008

ok. I've tried this and I get a run-time error '450': Wrong number of arguements or invalid property assignment.

Is this due to the file being an .xla?

SkipVought · Mar 11, 2008

my mistake. it is read-only.

Skip,
_{Have you heard that the roundest knight at King Arthur's round table was...

Sir Cumference!}

hrm1220 · Mar 11, 2008

nope. I've put in the following code and I still get the same error :
Workbooks("Customviews.xla").Worksheets(i).CodeName = Newsheetname(0)

The "trust all installed add-ins and templates" and "trust access to Visual Basic Project" are checked in teh "trusted Publishers in the security.

SkipVought · Mar 11, 2008

"nope. I've put in the following code and I still get the same error :"

???

Did you not read my last reply?

Check HELP!

Skip,
_{Have you heard that the roundest knight at King Arthur's round table was...

Sir Cumference!}

hrm1220 · Mar 11, 2008

sorry I thought you were asking IS it read-only, transposed words again. I'm just a little confused on this. If the .xla is truly read only then how was I able to add a sheet to the .xla file as well as change the sheet name? (see bold code below)

Code:

Private Sub custom()
Dim endcol, i, a, space, lastspace

 Workbooks("Customviews.xla").IsAddin = True
Set startheader = Application.InputBox( _
    prompt:="Select a cell", Type:=8)
    msg = MsgBox("Do you want to save this view?", vbYesNo)
    If msg = 6 Then
    startheader.Select
    Selection.End(xlToRight).Select
    endcol = ActiveCell.Column
    Newsheet = ActiveSheet.Name
    Range(Cells(startheader.Row, startheader.Column), Cells(startheader.Row, endcol)).Select
    Selection.Copy
    [b]Workbooks("Customviews.xla").IsAddin = False
    Sheets.Add
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveSheet.Name = Newsheet[/b]
    i = ActiveSheet.Index
    Newsheetname = Split(Newsheet, " ")
    ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Worksheets(i)).Name = Newsheetname(0)
    Workbooks("Customviews.xla").IsAddin = True
    End If
On Error GoTo Error_Handler
    Range(startheader.Address).Select
    frm_Custom_Views.Show
    Workbooks("CustomViews.XLA").IsAddin = True
    ActiveSheet.Unprotect
    Customview = True
    
    
     Workbooks("Customviews.xla").IsAddin = True
Exit Sub
Error_Handler:
    MsgBox ("Macro Failed to complete")
End Sub

SkipVought · Mar 11, 2008

You can change the worksheet Name property but not the CodeName property.

Skip,
_{Have you heard that the roundest knight at King Arthur's round table was...

Sir Cumference!}

hrm1220 · Mar 11, 2008

ok. sorry for all the confusion. I believe I was wanting Workbook object. I've added this code in and it works:

Code:

 ThisWorkbook.VBProject.VBComponents(Worksheets(i).CodeName).Name=Newsheetname(0)

Thanks again for your help.

hrm1220 · Mar 17, 2008

sorry I have a follow up question. For the following line in code:For Each r In Range([A1], [A1].End(xlDown))
is there a way to change [A1] to a cell value the user selects?

Code:

Private Sub PopulateListbox()
    Dim r As Range, c As Range, i As Integer
    
    i = 0
    lstStep_List.Clear
    For Each r In Range([A1], [A1].End(xlDown))
        For Each c In Range([A1], [A1].End(xlToRight))
            lstStep_List.AddItem (Cells(r.Row, c.Column).Value)
            If Application.VLookup(Cells(r.Row, c.Column).Value, Schedule_Views.Range("a1:b260"), 2, False) = "Hide Column" Then
                lstStep_List.Selected(i) = True '"THIS IS WHERE IT BREAKS"
             Else
                lstStep_List.Selected(i) = False '"THIS IS WHERE IT BREAKS"
            End If
            i = i + 1
        Next
    Next
    
End Sub

thx for your help

SkipVought · Mar 17, 2008

Code:

For Each r In Range(ActiveCell, ActiveCell.End(xlDown))

Skip,
_{Have you heard that the roundest knight at King Arthur's round table was...

Sir Cumference!}

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Pre-select items in a list box through VBA

Technical User

Programmer

Technical User

Technical User

Programmer

Technical User

Programmer

Technical User

Programmer

Technical User

Programmer

Technical User

Programmer

Technical User

Programmer

Technical User

Programmer

Technical User

Technical User

Programmer

Similar threads

Log in

Part and Inventory Search

Sponsor