accessing workbook fails

[Ron Proschan]

Here is a script that works the first time through. Basically what it does
is grab a group of records based on identical class membership and then save
that group of students as a new file with the name of the class as the name
of the file. The problem occurs in the second loop -- see the area marked by
asterisks. I have created a file "workfile.xlsx" and accessed it
successfully the first time through, but in the next loop, I can't figure out
how to access it. I did a "save as" on workfile.xlsx in the loop, giving it
the new name from the spreadsheet column indicated. It seems to have a hard
time recovering from that. Or I've got all the qualifications wrong. Does
anyone see a cure? (It does work on the first loop). Thanks very much in
advance! Ron Proschan.


Option Explicit

Sub CutAndSaveFiles()
Dim myCellPos As Integer
Dim myRange As Range
Dim moveRange As Range
Dim startRange As Range
Dim destRange As Range
Dim nameRange As Range
Dim printRange As Range
Dim myFirstCellAddress As String
Dim myLastCellAddress As String
Dim mySecondCellAddress As String
Dim myThirdCellAddress As String
Dim Newfile As String
Dim myFilename As String
Dim TestValue As String
Dim MasterFile As String
Dim LastRow As Integer
Dim LastCol As Integer
Dim OKtoContinue As Boolean

' put cursor on first active cell with "1" in it

MasterFile = "PassFailCsesforRon.xls"
Windows(MasterFile).Activate
Workbooks.Add
ActiveWorkbook.saveAs Filename:="workfile.xlsx", FileFormat:=xlNormal,
CreateBackup:=False
Windows("workfile.xlsx").Activate
Windows(MasterFile).Activate
myFirstCellAddress = ActiveCell.Address
ActiveCell.Activate
If ActiveCell.Value = Empty Then
OKtoContinue = False
Exit Sub
End If
OKtoContinue = True

' MAJOR LOOP STARTS HERE
' __________________________________________________________________________
Do While OKtoContinue = True
Application.ScreenUpdating = False
ActiveCell.Offset(1, 0).Select
Do While (ActiveCell.Value <> 1) And (OKtoContinue = True)
If ActiveCell.Value = Empty Then
OKtoContinue = False
End If
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 8).Select
If ActiveCell.Value = Empty Then
ActiveCell.Offset(-1, 0).Select
End If
myFilename = ActiveCell.Value
ActiveCell.Offset(0, 8).Select
myLastCellAddress = ActiveCell.Address
Newfile = myFilename
Set moveRange = Range(myFirstCellAddress, myLastCellAddress)

*****
'***************************ERROR****************************************
'breaks down here, trying to get to workfile.xlsx, on 2nd loop (not first)
'***************************ERROR****************************************
Windows("workfile.xlsx").Activate
Set destRange = Workbooks("workfile.xlsx").Sheets("Sheet1").Range("A2")
*****

moveRange.Copy destRange
ActiveWorkbook.saveAs Filename:=Newfile

With Worksheets("Sheet1").Columns("C")
.ColumnWidth = .ColumnWidth * 4
End With
Worksheets("Sheet1").Range("A1").Value = myFilename
Worksheets("Sheet1").Range("D1").Value = "grade"
Worksheets("Sheet1").Range("H1").Value = "y/n"

' set print area to A through H, active rows only
Range("A1").Select
mySecondCellAddress = ActiveCell.Address
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A10000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 7).Select
myThirdCellAddress = ActiveCell.Address
Set printRange = Range(mySecondCellAddress, myThirdCellAddress)
ActiveSheet.PageSetup.PrintArea = printRange.Address

' unlock columns D and H
Columns("D").Select
Selection.Locked = False
Selection.FormulaHidden = False
Columns("H:H").Select
Selection.Locked = False
Selection.FormulaHidden = False
Range("A1").Select

' protect sheet
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
ActiveWorkbook.Save

'Windows.Application.ActiveWorkbook ("workfile.xlsx")
Windows(MasterFile).Activate
Worksheets("Sheet1").Activate
Set nameRange = Range(myLastCellAddress)
nameRange.Select
ActiveCell.Activate
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, -16).Select
ActiveCell.Select
myFirstCellAddress = ActiveCell.Address
Loop
Application.ScreenUpdating = True
ActiveWorkbook.Close (True)

End Sub

 

[Gary''s Student]

You can avoid trouble re-Activating Windows by remembering its Caption.

Any time you perform an ActiveWorkbook.saveAs
or
Workbooks.Add

use something like winName=ActiveWorkbook.Caption
and then later on

Windows(winName).Activate

 

[Nigel]

Try using.....

Workbooks("workfile").Activate

I would also set a reference to it

Dim wbWFile as Workbook
Workbooks.Add
Set wbWFile = ActiveWorkbook

Thereafter refer to

wbWFile.Activate

etc..

--

Regards,
Nigel
(e-mail address removed)

 

[Ron Proschan]

Thanks. I used your line, but it didn't work. It seems to have something to
do with the file "workfiles.xlsx" being corrupted or not usable after the
"saveAs" of its contents as a different file. Any ideas?

 

[Ron Proschan]

These are all helpful suggestions. But I realize now the basic problem I'm
having is opening a workfile, adding data, doing "saveAs" or "saveCopy As"
on that workfile, and then somehow clearing the workfile, and then reusing
the workfile. I'm doing something wrong there that's causing file corruption
of the workfile. It works fine the first time around, but it can never be
opened again, even in the regular Excel interface. Do you think I'm on the
wrong track trying to use and reuse the same workfile?