Open Files, perform action - fails - VBA

  • Thread starter Thread starter richg41
  • Start date Start date
R

richg41

The following code casues an application defined error and I need hel
understanding why. The code for finding the word "closed" in column
works fine in a worksheet all by itself. And the code that reads
file list from a directory works fine by itself. However, the tw
together seem not to behave together...Any thoughts????



Sub OpenWorkbooksInLocation()
Application.ScreenUpdating = True 'to see whats happening
Dim i As Integer
With Application.FileSearch 'find files
.NewSearch
.LookIn = "C:\Test" 'Amend to suit
.SearchSubFolders = False
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count 'increment count
Set wb = Workbooks.Open(Filename:=.FoundFiles(i))
'set first found file??
With wb.Worksheets("OPEN") 'name of worksheet is OPEN
' moves closed items in column i to sheet named closed
Columns("I:I").Select ' CAUSES APPLICATION DEFINED ERROR
Do While Selection.Find(what:="closed", After:=ActiveCell
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.EntireRow.Select
Selection.Copy
ActiveSheet.Next.Select
Application.Goto Reference:="R3C1"
Selection.Insert shift:=xlDown
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=0
ActiveSheet.Previous.Select
Selection.ClearContents
Selection.ClearContents
Selection.Delete shift:=xlUp
Columns("I:I").Select
Loop
wb.Save
wb.Close
End With
Next i
End With
Application.ScreenUpdating = True
End Su
 
Without comments on the rest, is there a period in front of
Columns("I:I").Select
to be
..Columns("I:I").Select
 
Thanks Don, Maybe you should have commented on the rest. As you ca
probably tell I am very new to VBA and programming. After I inserte
the period into the code I was able to step through the code. Th
directory I am retrieving files from has 5 files and this part worked.
The first file allowed me to continue processing and removing th
"closed" items to the closed worksheet. Then the second file opene
and I looped through removing the closed items. Hoever; there in wa
the end. As soon as all closed items were removed, I recieved th
following error.

Run time Error 91 - Object variable or With Block vaiable not set.

I haven't a clue and would be very gracious if you could help m
out...I have no pride of authorship...it is really pretty neat gettin
something like this to work.

Thanks,

Ric
 
One of the problems with selecting a range is that the worksheet that owns that
range must be active.

And while you're testing, you might have that worksheet active and so it works
fine. But if you open the workbook, you might not get that lucky.

Try this version against a copy of your workbooks in a different folder.

Option Explicit
Sub OpenWorkbooksInLocation2()

Dim WB As Workbook
Dim i As Long
Dim FoundCell As Range
Dim DestCell As Range
Dim FoundClosed As Boolean

Application.ScreenUpdating = True 'to see whats happening

With Application.FileSearch 'find files
.NewSearch
.LookIn = "C:\Test" 'Amend to suit
.SearchSubFolders = False
.Filename = "*.xls"
.Execute

For i = 1 To .FoundFiles.Count 'increment count
Set WB = Workbooks.Open(Filename:=.FoundFiles(i))
FoundClosed = False
If WorksheetExists("open", WB) _
And WorksheetExists("closed", WB) Then
'set first found file??
With WB.Worksheets("OPEN") 'name of worksheet is OPEN
' moves closed items in column i to sheet named closed
Do
With .Columns("I:I")
Set FoundCell = Nothing
Set FoundCell = .Cells.Find(what:="closed", _
after:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
MatchCase:=False, _
searchformat:=False)

If FoundCell Is Nothing Then
Exit Do
Else
FoundClosed = True
With
WB.Worksheets("closed")
Set DestCell = .Range("A3")
End With
FoundCell.EntireRow.Copy
DestCell.Insert shift:=xlDown
FoundCell.EntireRow.Delete
End If
End With
Loop
End With
Else
MsgBox "Open/Closed worksheet not found in: " & WB.Name
End If

Application.CutCopyMode = False
WB.Close savechanges:=FoundClosed

Next i
End With
Application.ScreenUpdating = True
End Sub

Function WorksheetExists(SheetName As String, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function

I used the worksheet named closed to put the data.

I added a function stolen from Chip Pearson that ensures that the worksheet is
in the workbook before continuing.

And as an alternative:

I like to start at the bottom of the column and go to the top (like going to
A65536, hitting End, then up arrow, then the down arrow once.)

This adds to the bottom of the list--instead of inserting it at the top.

If you like this idea:

Replace this portion:

FoundClosed = True
With WB.Worksheets("closed")
Set DestCell = .Range("A3")
End With
FoundCell.EntireRow.Copy
DestCell.Insert shift:=xlDown
FoundCell.EntireRow.Delete

with:

FoundClosed = True
With WB.Worksheets("closed")
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
FoundCell.EntireRow.Copy _
Destination:=DestCell
FoundCell.EntireRow.Delete

(But it's mostly personal preference & what you really want it to look like when
you're done.)
 
Watchout for line wrap in my post:
With
WB.Worksheets("closed")
Set DestCell = .Range("A3")
Click to expand...


That's actually just one line:

with wb.worksheets("closed")
Set DestCell = .Range("A3")
 
Dave,

I am certain you hear this alot....Thank You...I really needed hel
with this project and you provided assistance so quickly... I am ver
greatful.

I have tried your code and WOW ... worked like a charm right out of th
box.

what you did for me, without even knowing me or recieving compensatio
is a memorable event of kindness I shall not forget.

Best Regards,

Ric
 
Glad it worked!



richg41 < said:
Dave,

I am certain you hear this alot....Thank You...I really needed help
with this project and you provided assistance so quickly... I am very
greatful.

I have tried your code and WOW ... worked like a charm right out of the
box.

what you did for me, without even knowing me or recieving compensation
is a memorable event of kindness I shall not forget.

Best Regards,

Rich
Click to expand...
 
Back
Top