xfr79
12-15-2008, 03:09 PM
I have a script below.
An explaination on what this script does.
If user was on worksheet "CAL" and they wanted to see if the worksheet was also in other workbooks. They would run this script. The script would then open up workbooks in a specific directory and see if any workbooks in that directory contain the worksheet "CAL". If any matches were found, the script would add the workbook names to listbox1. When a user would double click on the workbook name in listbox1, it would displayed the worksheet name in listbox2.
What i'm trying to do is, instead of listing the worksheet name in listbox2, I would like the script to display cell ranges from the worksheets it found.
The cell ranges are ws.Range("C16"), ws.Range("E16"), ws.Range("C17"), ws.Range("B18"), ws.Range("B19") and ws.Range("B20").
I would like for each cell range to have it's own line in the listbox.
ws.Range("C16")
ws.Range("E16")
ws.Range("C17")
ws.Range("B18")
ws.Range("B19")
ws.Range("B20")
i'm at a loss, hopefully someone can help me out!
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 = "C:\S9\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 5)
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) = wb.Name
w(2) = " Total Tardy: " & ws.Range("C16")
w(3) = " Total Absense: " & ws.Range("E16")
w(4) = " " & ws.Range("C17") & " " & ws.Range("B18")
w(5) = " " & ws.Range("B19") & " " & ws.Range("B20")
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
An explaination on what this script does.
If user was on worksheet "CAL" and they wanted to see if the worksheet was also in other workbooks. They would run this script. The script would then open up workbooks in a specific directory and see if any workbooks in that directory contain the worksheet "CAL". If any matches were found, the script would add the workbook names to listbox1. When a user would double click on the workbook name in listbox1, it would displayed the worksheet name in listbox2.
What i'm trying to do is, instead of listing the worksheet name in listbox2, I would like the script to display cell ranges from the worksheets it found.
The cell ranges are ws.Range("C16"), ws.Range("E16"), ws.Range("C17"), ws.Range("B18"), ws.Range("B19") and ws.Range("B20").
I would like for each cell range to have it's own line in the listbox.
ws.Range("C16")
ws.Range("E16")
ws.Range("C17")
ws.Range("B18")
ws.Range("B19")
ws.Range("B20")
i'm at a loss, hopefully someone can help me out!
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 = "C:\S9\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 5)
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) = wb.Name
w(2) = " Total Tardy: " & ws.Range("C16")
w(3) = " Total Absense: " & ws.Range("E16")
w(4) = " " & ws.Range("C17") & " " & ws.Range("B18")
w(5) = " " & ws.Range("B19") & " " & ws.Range("B20")
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