Collection tries to open /.xls

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

The following works perfect until the end it tries to open a blank filename.
I have blank cells in my range. Any help please?


Dim bkList As New Collection
With Workbooks("1DLSUNDAY.XLS").Worksheets("Master")
Set rng = .Range(.Cells(2, 3), .Cells(200, 3).End(xlDown))
End With

On Error Resume Next
For Each cell In rng
bkList.Add Trim(cell.Text), Trim(cell.Text)
Next
On Error GoTo 0

For Each itm In bkList
Workbooks.Open "C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\" & _
itm & ".xls"
Next
 
Maybe just skip the cells that are blank--don't add them to your collection:

On Error Resume Next
For Each cell In rng
bkList.Add Trim(cell.Text), Trim(cell.Text)
Next
On Error GoTo 0

becomes

On Error Resume Next
For Each cell In rng
if trim(cell.text) = "" then
'skip it
else
bkList.Add Trim(cell.Text), Trim(cell.Text)
end if
Next
 
Dim bkList As New Collection
With Workbooks("1DLSUNDAY.XLS").Worksheets("Master")
Set rng = .Range(.Cells(2, 3), .Cells(200, 3).End(xlDown))
End With

On Error Resume Next
For Each cell In rng
if len(trim(cell)) > 0 then
bkList.Add Trim(cell.Text), Trim(cell.Text)
end if
Next
On Error GoTo 0

For Each itm In bkList
Workbooks.Open "C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\" & _
itm & ".xls"
Next
 
Thanks again guys.

Dave Peterson said:
Maybe just skip the cells that are blank--don't add them to your collection:

On Error Resume Next
For Each cell In rng
bkList.Add Trim(cell.Text), Trim(cell.Text)
Next
On Error GoTo 0

becomes

On Error Resume Next
For Each cell In rng
if trim(cell.text) = "" then
'skip it
else
bkList.Add Trim(cell.Text), Trim(cell.Text)
end if
Next
Click to expand...
 
On the last line it should say Next itm instead of just Next also in
the middle next should be next cell. You also probably don't need to
create a collection in order to do this. I assume that each cell in
rng contains a workbook name. So you could just do:

With Workbooks("1DLSUNDAY.XLS").Worksheets("Master")
Set rng = .Range(.Cells(2, 3), .Cells(200, 3).End(xlDown))
End with

For each cell in rng
Workbooks.Open "C:\Documents and Settings\Tom\Desktop\CHARTER
BLANK\NEW BLANK\" & cell.value & ".xls"
Next cell
 
Thanks, but the list is just a column of Technicians on a jobs spreadsheet so
each Tech appears multiple times and some cells are blank. Your way is the
way I started but it didn't work very well.
 
Dim bkList As New Collection
With Workbooks("1DLSUNDAY.XLS").Worksheets("Master")
Set rng = .Range(.Cells(2, 3), .Cells(200, 3).End(xlDown))
End With

On Error Resume Next
For Each cell In rng
if len(trim(cell)) > 0 then
if cell.Value < 9521 then
bkList.Add Trim(cell.Text), Trim(cell.Text)
End if
end if
Next
On Error GoTo 0

For Each itm In bkList
Workbooks.Open "C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\" & _
itm & ".xls"
Next
 
Back
Top