Consulting

Results 1 to 3 of 3

Thread: Solved: Select item in list if only one exists

  1. #1
    VBAX Tutor
    Joined
    Dec 2006
    Posts
    271
    Location

    Solved: Select item in list if only one exists

    I use this code to populate a listview and correctly displays the msg if there is only one item in the list.

    [vba]With Me.lvwPackGroups
    .ListItems.Clear
    .HoverSelection = False
    .LabelEdit = lvwManual
    x = 1
    For i = 2 To r
    .ListItems.Add , , wsPgroup.Cells(i, "B").Value 'product ID
    .ListItems(x).ListSubItems.Add , , wsPgroup.Cells(i, "E").Value
    x = x + 1
    Next i

    If .ListItems.Count = 1 Then
    'msgbox only 1 item is in list
    'perform macro as though item was selected.
    Else
    'more than one item to coose from
    End If

    End With[/vba]

    If there is only 1 item I would like the routine that would normally run when that item is selected in the subsequent listview.

    This is the routine for itemclick

    [vba]Private Sub lvwPackGroups_ItemClick(ByVal item As MSComctlLib.ListItem)
    Dim pCount As Long, x As Long, r As Long, idx As Long
    Dim pkText As String
    pckGrpID = item.Text
    pckGrpdesc = item.SubItems(1)
    idx = Application.WorksheetFunction.Match(pckGrpID, wsPgroup.Columns(2), 0)
    pkText = wsPgroup.Cells(idx, "F").Value
    Me.txtPkText.Value = pkText
    Call QryPackGroupLink(pckGrpID)
    pCount = wsPack.Cells(Rows.Count, "A").End(xlUp).row
    With Me.lvwPacks
    .ListItems.Clear
    x = 1
    For i = 2 To pCount
    .ListItems.Add , , wsPack.Cells(i, "B").Value 'product ID
    .ListItems(x).ListSubItems.Add , , wsPack.Cells(i, "E").Value
    .ListItems(x).ListSubItems.Add , , wsPack.Cells(i, "C").Value

    x = x + 1
    Next i
    End With
    End Sub[/vba]

    Something like: [vba]Call lvwPackGroups_itemClick(1) ?[/vba]

  2. #2
    VBAX Tutor
    Joined
    Aug 2007
    Posts
    273
    Location
    this should work
    [VBA]With Me.lvwPackGroups
    .listitems.Clear
    .HoverSelection = False
    .LabelEdit = lvwManual
    x = 1
    For I = 2 To r
    .listitems.Add , , wsPgroup.Cells(I, "B").Value 'product ID
    .listitems(x).ListSubItems.Add , , wsPgroup.Cells(I, "E").Value
    x = x + 1
    Next I

    If .listitems.Count = 1 Then
    'msgbox only 1 item is in list
    'perform macro as though item was selected.
    tem .listitems(1) 'this might need to be 0 instead of 1
    Else
    'more than one item to coose from
    End If

    End With


    Private Sub lvwPackGroups_ItemClick(ByVal item As MSComctlLib.ListItem)
    temp item
    End Sub

    Function temp(item As MSComctlLib.ListItem)
    Dim pCount As Long, x As Long, r As Long, idx As Long
    Dim pkText As String
    pckGrpID = item.Text
    pckGrpdesc = item.SubItems(1)
    idx = Application.WorksheetFunction.Match(pckGrpID, wsPgroup.Columns(2), 0)
    pkText = wsPgroup.Cells(idx, "F").Value
    Me.txtPkText.Value = pkText
    Call QryPackGroupLink(pckGrpID)
    pCount = wsPack.Cells(Rows.Count, "A").End(xlUp).Row
    With Me.lvwPacks
    .listitems.Clear
    x = 1
    For I = 2 To pCount
    .listitems.Add , , wsPack.Cells(I, "B").Value 'product ID
    .listitems(x).ListSubItems.Add , , wsPack.Cells(I, "E").Value
    .listitems(x).ListSubItems.Add , , wsPack.Cells(I, "C").Value

    x = x + 1
    Next I
    End With
    End Function[/VBA]

  3. #3
    VBAX Tutor
    Joined
    Dec 2006
    Posts
    271
    Location

    Thanks

    Thanks figment thats worked a treat!

    FYI it was
    temp .listitems(1) for the first item

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •