Announcement

Collapse
No announcement yet.

Unconfigured Ad Widget

Collapse

List Files & Cell Values With Specific Sheet Names From ListBox

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • List Files & Cell Values With Specific Sheet Names From ListBox

    I have this script (below, Krishnakumar orignally provided this script).

    I'm trying to edit it to add cell values from cells C16 and E16 along with the worksheet name it displays in listbox2. So lets say worksheet "rollover" is the sheet being displayed in the listbox2.

    I would like for it to look something like this:

    rollover TT:'data from cell C16' TA:'data from cell E16'

    is this possible?

    Code:
    Public FilePath As String
    Public dic      As Object
    Public oWB      As String
    Public oWS      As String
    Public aWS      As Worksheet
    
    Private Sub CommandButton1_Click()
        Dim i   As Long, wb As Workbook, n As Long
        With Me.ListBox2
            For i = 0 To .ListCount - 1
                If .Selected(i) = True Then
                    oWS = .list(i)
                    Set wb = Workbooks.Open(FilePath & oWB, UpdateLinks:=0)
                    wb.Sheets(oWS).Activate
                    Exit For
                End If
            Next
        End With
    End Sub
     
     
    Private Sub CommandButton3_Click()
        Set dic = Nothing
        Unload Me
    End Sub
    
    Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
        Dim i As Long, w(), j As Long, s()
        With Me
            .ListBox2.Clear
            For i = 0 To .ListBox1.ListCount - 1
                If .ListBox1.Selected(i) = True Then
                    .ListBox2.AddItem aWS.Name
                    oWB = .ListBox1.list(i)
                End If
            Next
        End With
    End Sub
    
    
    Private Sub UserForm_Initialize()
    
        Dim FileList(), i   As Long, n    As Long, fName As String, shtName()
        Dim wb As Workbook, ws As Worksheet
        
        Set dic = CreateObject("scripting.dictionary")
        dic.comparemode = vbTextCompare
    
        FilePath = "L:\Sec09\AttendanceHistory\"
        Userform1.Caption = "List of xls files in " & FilePath
        fName = Dir(FilePath & "*.xls")
        Set aWS = ActiveSheet
        On Error GoTo Xit
        With Application
            .ScreenUpdating = 0
            .EnableEvents = 0
            .DisplayAlerts = 0
        End With
    i = 1:
        Do While fName <> ""
            If fName <> ThisWorkbook.Name Then
                Set wb = Workbooks.Open(FilePath & fName, UpdateLinks:=0)
                For Each ws In wb.Worksheets
                    If ws.Name = aWS.Name Then
                        If Not dic.exists(fName) Then
                            dic.add fName, ws.Name
                            Exit For
                        End If
                    End If
                Next
                wb.Close False: Set wb = Nothing
            End If
            fName = Dir()
         Loop
        With Me.ListBox1
            .Clear
            .list = dic.keys
        End With
    Xit:
        With Application
            .ScreenUpdating = 1
            .EnableEvents = 1
            .DisplayAlerts = 1
        End With
    End Sub


    edit: my apologies for creating a new thread, I just realized I had other threads created.

  • #2
    Re: List Files &amp; Cell Values With Specific Sheet Names From ListBox

    Hi,

    Change the userform initialize code

    Private Sub UserForm_Initialize()

    Dim FileList(), i As Long, n As Long, fName As String, shtName()
    Dim wb As Workbook, ws As Worksheet, w()

    Set dic = CreateObject("scripting.dictionary")
    dic.comparemode = vbTextCompare

    FilePath = "L:\Sec09\AttendanceHistory\"
    UserForm1.Caption = "List of xls files in " & FilePath
    fName = Dir(FilePath & "*.xls")
    Set aWS = ActiveSheet
    On Error GoTo Xit
    With Application
    .ScreenUpdating = 0
    .EnableEvents = 0
    .DisplayAlerts = 0
    End With
    i = 1:
    ReDim w(1 To 2)
    Do While fName <> ""
    If fName <> ThisWorkbook.Name Then
    Set wb = Workbooks.Open(FilePath & fName, UpdateLinks:=0)
    For Each ws In wb.Worksheets
    If ws.Name = aWS.Name Then
    If Not dic.exists(fName) Then
    w(1) = ws.Name
    w(2) = ws.Name & " TT:" & ws.Range("c16") & " TA:" & ws.Range("E16")
    dic.Add fName, w
    Exit For
    End If
    End If
    Next
    wb.Close False: Set wb = Nothing
    End If
    fName = Dir()
    Loop
    With Me.ListBox1
    .Clear
    .List = Application.Transpose(Application.Transpose(dic.items))
    End With
    Xit:
    With Application
    .ScreenUpdating = 1
    .EnableEvents = 1
    .DisplayAlerts = 1
    End With
    End Sub


    HTH
    Kris

    ExcelFox

    Comment


    • #3
      Re: List Files &amp; Cell Values With Specific Sheet Names From ListBox

      Krishnakumar,
      It does what I was looking for, but it replaces the workbook names data with the worksheet names and cell data. I want to keep listbox1 for just the workbook names and have listbox2 display the worksheet name and cell data after the double click. Like the way it works with the original script but with the cell data also.

      Thanks!!

      Comment


      • #4
        Re: List Files &amp; Cell Values With Specific Sheet Names From ListBox

        i've been looking at the script, I think it would be more feasible to just have the cell data in place of the worksheet name in listbox2.
        So when I double click on the workbook name, it would show the cell data instead of the worksheet name.
        Is that doable?

        Comment


        • #5
          Re: List Files &amp; Cell Values With Specific Sheet Names From ListBox

          Hi,

          Public FilePath As String
          Public dic As Object
          Public oWB As String
          Public oWS As String
          Public aWS As Worksheet

          Private Sub CommandButton1_Click()
          Dim i As Long, wb As Workbook, n As Long
          With Me.ListBox2
          For i = 0 To .ListCount - 1
          If .Selected(i) = True Then
          oWS = .List(i)
          Set wb = Workbooks.Open(FilePath & oWB, UpdateLinks:=0)
          wb.Sheets(oWS).Activate
          Exit For
          End If
          Next
          End With
          End Sub


          Private Sub CommandButton3_Click()
          Set dic = Nothing
          Unload Me
          End Sub

          Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
          Dim i As Long, w(), j As Long, s()
          With Me
          .ListBox2.Clear
          For i = 0 To .ListBox1.ListCount - 1
          If .ListBox1.Selected(i) = True Then
          oWB = .ListBox1.List(i)
          .ListBox2.List = Application.Transpose(Application.Transpose(dic.Item(oWB)))
          End If
          Next
          End With
          End Sub


          Private Sub UserForm_Initialize()

          Dim FileList(), i As Long, n As Long, fName As String, shtName()
          Dim wb As Workbook, ws As Worksheet

          Set dic = CreateObject("scripting.dictionary")
          dic.comparemode = vbTextCompare

          FilePath = "L:\Sec09\AttendanceHistory\"
          Userform1.Caption = "List of xls files in " & FilePath
          fName = Dir(FilePath & "*.xls")
          Set aWS = ActiveSheet
          On Error GoTo Xit
          With Application
          .ScreenUpdating = 0
          .EnableEvents = 0
          .DisplayAlerts = 0
          End With
          i = 1:
          Do While fName <> ""
          If fName <> ThisWorkbook.Name Then
          Set wb = Workbooks.Open(FilePath & fName, UpdateLinks:=0)
          For Each ws In wb.Worksheets
          If ws.Name = aWS.Name Then
          If Not dic.exists(fName) Then
          dic.Add fName, ws.Name & " TT:" & ws.Range("c16") & " TA:" & ws.Range("E16")
          Exit For
          End If
          End If
          Next
          wb.Close False: Set wb = Nothing
          End If
          fName = Dir()
          Loop
          With Me.ListBox1
          .Clear
          .List = dic.keys
          End With
          Xit:
          With Application
          .ScreenUpdating = 1
          .EnableEvents = 1
          .DisplayAlerts = 1
          End With
          End Sub


          Not tested.
          Kris

          ExcelFox

          Comment


          • #6
            Re: List Files &amp; Cell Values With Specific Sheet Names From ListBox

            Thanks for the reply Krishnakumar!
            i've been out of the office for a week, so i haven't looked at this thread since then.
            I changed the script with your input. I receive an error:

            Run-Time error '381'
            Could not set the List property. Invalid property array index.

            it highlights line:
            Code:
            .ListBox2.list = Application.Transpose(Application.Transpose(dic.Item(oWB)))
            Last edited by Dave Hawley; December 16th, 2008, 08:57.

            Comment


            • #7
              Re: List Files &amp; Cell Values With Specific Sheet Names From ListBox

              Hi,

              remove the error line and add the following

                  .ListBox2.Clear
              .ListBox2.AddItem dic.Item(oWB)


              HTH
              Kris

              ExcelFox

              Comment


              • #8
                Re: List Files &amp; Cell Values With Specific Sheet Names From ListBox

                Thank you Krishnakumar, that worked perfectly!!

                Comment

                Trending

                Collapse

                There are no results that meet this criteria.

                Working...
                X