Need help to increment default WorkBook name in code

[CB]

Hello,

Members of this newsgroup have been instrumental in helping me get my code
as far as I’ve gone. I have what I think is my final problem that I need help
with.

Users will be using my workbook to collect sensor data, save a copy of the
data to another file using a command button, then use another command button
to clear the data from the original file so they can test another sensor. The
process can be repeated as often as necessary.

I finally have my “Save Data†command button working how I want it to.
However, the button will NOT work properly a second or subsequent time. I
think I know exactly why it is behaving this way; I’m not sure how to fix it.
I’m thinking I need some type of loop but I’m not sure which is the best
method (Do…Loop, For…Next, For…Each…Next, If…Then…Else) and how to implement
it.

In a nutshell, my “Save Data†command button does the following:
- open a new workbook (i.e., “Book1â€)
- copy two worksheets from the original workbook to the new workbook
- save a COPY of the new workbook to the network with a new name
- close the new workbook (i.e., “Book1â€) without saving changes

The problem is that since the original workbook is NOT closed between each
sensor’s test, the second time the “Save Data†button is clicked (for the
second sensor) the new workbook created is now “Book2â€. I then get a run-time
error because the code contains “Book1.†What I’m thinking I need to do is
increment “Book#†each time the command button is clicked. I just don’t know
how.

I’m including the code for my “Save Data†command button if it will help.

Thanks in advance!

Chris

Private Sub SaveData_Click()

'The following code creates a new workbook and copies the worksheets from
the template into the new workbook. Code isn't copied.

Workbooks.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Pre-Service"
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Post-Service"
Sheets("Pre-Service").Select
Windows("SR50_Test_Data_Form_v2.xls").Activate
Sheets("Pre-Service").Select
ActiveSheet.Cells.Select
Selection.Copy
Windows("Book1").Activate
ActiveSheet.Paste
Sheets("Post-Service").Select
Windows("SR50_Test_Data_Form_v2.xls").Activate
Sheets("Post-Service").Select
ActiveSheet.Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Book1").Activate
ActiveSheet.Paste
Windows("SR50_Test_Data_Form_v2.xls").Activate
Windows("Book1").Activate
Application.CutCopyMode = False

'The following code saves a COPY of the new workbook to the network and
renames it. Before copying, it ensures a serial number was entered.
If Trim(Worksheets("Post-Service").Range("D3").Value = "") Then
MsgBox ("You must enter a serial number.")
Exit Sub
Else
Worksheets("Post-Service").Range("D3") =
UCase(Worksheets("Post-Service").Range("D3"))
If Left(Worksheets("Post-Service").Range("D3"), 1) = "C" Then
ActiveWorkbook.SaveCopyAs "\\MyPath\" & "SR50_SN_" & Range("d3")
& "_" & Format(Now, "yyyymmmdd") & Range("d5") & "_" & ".xls"
Else
If MsgBox("Are you sure the serial number doesn't begin with
C?", vbYesNo) = vbYes Then
ActiveWorkbook.SaveCopyAs "\\MyPath\" & "SR50_SN_" & Range("d3")
& "_" & Format(Now, "yyyymmmdd") & Range("d5") & "_" & ".xls"
Else
MsgBox ("Please fix the serial number.")
End If
End If
End If

Windows("Book1").Close Savechanges:=False

End Sub

 

[ND Pard]

Replace the line of code that contains:

Workbooks.Add

With:

Dim strNewWrkBkName as string
Workbooks.Add Template:="Workbook"
strNewWrkBkName = ActiveWorkBook.Name
Workbooks(("SR50_Test_Data_Form_v2.xls").Activate

Then, replace all references to Book1 with strNewWrkBkName

Good Luck

 

[Chip Pearson]

The first thing is to create a variable of type Workbook and then Set
it to the newly created workbook. E.g.,


Dim NewWB As Workbook
Set NewWB = Workbooks.Add

Then, change the lines

Windows("Book1").Activate

To

NewWB.Activate

In general, anywhere you would normally use Workbooks("Book1"), use
NewWB.

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[john]

see if this approach will do what you want.

Sub SaveData_Click()

Dim SourceRange As Range
Dim DestRange As Range

Dim NewBook As Workbook
Dim TDFormWb As Workbook

Dim OldShcount
Dim mypath As String


Set TDFormWb = Workbooks(ThisWorkbook.Name)

'Before copying, ensure a serial number
'has been entered correctly.
With TDFormWb.Worksheets("Post-Service").Range("D3")

.Value = UCase(.Value)

If .Value = "" Then

.Select

msg = MsgBox("You must enter a serial number.", _
16, "Serial Number Error")


Exit Sub

ElseIf Left(.Value, 1) <> "C" Then

.Select

msg = MsgBox("Are you sure the serial number doesn't begin with
C?", _
36, "Serial Number Error")

If msg = 7 Then

msg = MsgBox("Please fix the serial number.", _
16, "Serial Number Error")

Exit Sub

End If

End If

End With

With Application

OldShcount = .SheetsInNewWorkbook

.SheetsInNewWorkbook = 2

mypath = .Path

End With

'The following code creates a new workbook
'& renames the worksheets
Set NewBook = Workbooks.Add

With NewBook
.Title = "Sensor Data"
.Subject = ""
.Comments = ""
.Author = Application.UserName

.Sheets(1).Name = "Pre-Service"
.Sheets(2).Name = "Post-Service"
End With


'Reset no sheets in new workbook
'back to orig setting
Application.SheetsInNewWorkbook = OldShcount
'

'copies the template data into the new workbook.
'VBA worksheet Code & sheet objects are not copied.

With TDFormWb

Set SourceRange = .Sheets("Pre-Service").Cells
Set DestRange = NewBook.Worksheets("Pre-Service").Range("A1")

SourceRange.Copy

DestRange.PasteSpecial xlPasteAll, , False, False
Application.CutCopyMode = False
Set SourceRange = Nothing
Set DestRange = Nothing

Set SourceRange = .Sheets("Post-Service").Cells
Set DestRange = NewBook.Worksheets("Pre-Service").Range("A1")

SourceRange.Copy

DestRange.PasteSpecial xlPasteAll, , False, False
Application.CutCopyMode = False
Set SourceRange = Nothing
Set DestRange = Nothing

End With

'save the new workbook to the network and
'rename it.

With NewBook

.SaveAs "\\MyPath\" & "SR50_SN_" & Range("d3") _
& "_" & Format(Now, "yyyymmmdd") & _
Range("d5").Value & _
"_" & ".xls"


'close new workbook
.Close False

End With

msg = MsgBox("Workbook data has been copied & Saved!", _
vbInformation, "Copy Workbook Data")

Set NewBook = Nothing

End Sub

 

[CB]

Hi Chip,

I added the two lines you suggested and changed the three instances of
Windows("Book1").Activate. Unfortunately, I now get a run-time error (424 -
object required) and the debugger stops on the first instance of
NewWB.Activate.

Which object is missing?

Thanks for responding!

Chris

 

[CB]

Hi ND Pard,

Thanks for taking the time to respond. If I understand your code properly,
the new workbooks will have the same name as the original workbook. Is this
correct?

Chris

 

[CB]

HI John,

Wow, thanks so much for taking the time to rework my code! I hope I can give
it a go before I leave to catch my flight. I'll post more later.

Chris

 

[CB]

Hi John,

Just returned from my trip and tried your code. It worked like a charm!
Thanks so much for your help!

Regards,
Chris