I have a program that calls up excel and inserts in numbers for
reporting purposes. I do not have access to the program that does this.
The program itself will print off the report once the information is in
it. I have changed the template to include a macro that runs on the
BeforePrint event.

Basically all I am doing is creating a new workbook, or editing an old
one depending on circumstances. However, while the macro runs fine when
I test it. Somehow, when the program calls up the file, it does not
error out (I have yet to put in error protection) but will skip over
some of the key steps (i.e. Workbooks.Add or Workbooks.Open( SavePath &
NewBookName) will not actually take place, but the code will act like
it did. It also skips over

Here is the actual code I only know the steps that is skipping that are
making it fail, I do not know if there are other steps that it is
missing.


Function ConsolidateDBR()
Dim SitePath As String
Dim SiteNum As String
Dim NewBookName As String
Dim MonthlyBook As Workbook
Dim SavePath As String
Dim CurrentBook As Workbook
Dim Counter As Long
Dim tmpSheet As String
Dim NewBook As Boolean
NewBook = False
SitePath = ActiveWorkbook.Path
Set CurrentBook = Workbooks(ActiveWorkbook.Name)
If Right(SitePath, 1) = "\" Then
SitePath = Left(SitePath, Len(SitePath) - 1)
End If
NewBookName = "DBR" & Format(Cells(3, 26).Value, "yyyy-mmm") &
".xls"
SiteNum = Mid(SitePath, 7, Len(SitePath) - 6)
SavePath = "C:\DBR-Report"
MakeDirectory SavePath
If Right(SavePath, 1) < "\" Then
SavePath = SavePath & "\"
End If
If Dir$(SavePath & NewBookName) = "" Then
Set MonthlyBook = Workbooks.Add
NewBook = True
MonthlyBook.SaveAs SavePath & NewBookName, xlNormal
Else
Set MonthlyBook = Workbooks.Open(SavePath & NewBookName, , False)
End If
CurrentBook.Activate
Cells.Copy
With MonthlyBook
..Activate
Counter = 1
While .Sheets.Count = Counter
If .Sheets(Counter).Name = SiteNum Then
tmpSheet = SiteNum
End If
Counter = Counter + 1
Wend
If tmpSheet = "" Then
If NewBook = False Then
..Sheets.Add
End If
..ActiveSheet.Name = SiteNum
End If
..Sheets(SiteNum).Select
End With
Cells.PasteSpecial xlPasteAll
MonthlyBook.Save
MonthlyBook.Close
End Function
Function MakeDirectory(Directory As String)
On Error GoTo Created:
MkDir (Directory)
Created:
End Function

Thank you in advance for your help

-John


--
kraljb
------------------------------------------------------------------------
kraljb's Profile: http://www.excelforum.com/member.php...fo&userid=9955
View this thread: http://www.excelforum.com/showthread...hreadid=374651

I suggest experimentally inserting the DoEvents line, say, after all of the
following, and see where it gets you. This is probably overkill:
i) MakeDirectory SavePath
ii) All Workbooks.Add, Save and Close code
iii) All Activate code
iv) The Cells.Copy line
v) The Cells.PasteSpecial xlPasteAll line

Regards,
Greg


"kraljb" wrote:


I have a program that calls up excel and inserts in numbers for
reporting purposes. I do not have access to the program that does this.
The program itself will print off the report once the information is in
it. I have changed the template to include a macro that runs on the
BeforePrint event.

Basically all I am doing is creating a new workbook, or editing an old
one depending on circumstances. However, while the macro runs fine when
I test it. Somehow, when the program calls up the file, it does not
error out (I have yet to put in error protection) but will skip over
some of the key steps (i.e. Workbooks.Add or Workbooks.Open( SavePath &
NewBookName) will not actually take place, but the code will act like
it did. It also skips over

Here is the actual code I only know the steps that is skipping that are
making it fail, I do not know if there are other steps that it is
missing.


Function ConsolidateDBR()
Dim SitePath As String
Dim SiteNum As String
Dim NewBookName As String
Dim MonthlyBook As Workbook
Dim SavePath As String
Dim CurrentBook As Workbook
Dim Counter As Long
Dim tmpSheet As String
Dim NewBook As Boolean
NewBook = False
SitePath = ActiveWorkbook.Path
Set CurrentBook = Workbooks(ActiveWorkbook.Name)
If Right(SitePath, 1) = "\" Then
SitePath = Left(SitePath, Len(SitePath) - 1)
End If
NewBookName = "DBR" & Format(Cells(3, 26).Value, "yyyy-mmm") &
".xls"
SiteNum = Mid(SitePath, 7, Len(SitePath) - 6)
SavePath = "C:\DBR-Report"
MakeDirectory SavePath
If Right(SavePath, 1) < "\" Then
SavePath = SavePath & "\"
End If
If Dir$(SavePath & NewBookName) = "" Then
Set MonthlyBook = Workbooks.Add
NewBook = True
MonthlyBook.SaveAs SavePath & NewBookName, xlNormal
Else
Set MonthlyBook = Workbooks.Open(SavePath & NewBookName, , False)
End If
CurrentBook.Activate
Cells.Copy
With MonthlyBook
.Activate
Counter = 1
While .Sheets.Count = Counter
If .Sheets(Counter).Name = SiteNum Then
tmpSheet = SiteNum
End If
Counter = Counter + 1
Wend
If tmpSheet = "" Then
If NewBook = False Then
.Sheets.Add
End If
.ActiveSheet.Name = SiteNum
End If
.Sheets(SiteNum).Select
End With
Cells.PasteSpecial xlPasteAll
MonthlyBook.Save
MonthlyBook.Close
End Function
Function MakeDirectory(Directory As String)
On Error GoTo Created:
MkDir (Directory)
Created:
End Function

Thank you in advance for your help

-John


--
kraljb
------------------------------------------------------------------------
kraljb's Profile: http://www.excelforum.com/member.php...fo&userid=9955
View this thread: http://www.excelforum.com/showthread...hreadid=374651