I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

Anyone??...


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

ok, jess, i'll bite........... :) but keep in mind i'm no guru.
in looking @ your code (i have not tried it out), it
seems as though what you want somewhere in there
is an "if" statement. that way it won't do it for every
number, only if the number exists.

so first you have to figure out what you want:
if "dealername" appears in the list on "dealerlist", then
do your stuff.
else
do other stuff
end if

does this help? i'd help you write it, but as i said
i'm no guru & it'd take me two hours to write it &
test it, plus the time it'd take me to research
stuff in the newsgroup. :)
susan


Jess wrote:
Anyone??...


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

I want each of the copies a separate workbook.

Jason Lepack wrote:
Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

Try this one on, if it has any issues, just post back.

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once oyu hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add
wsNew.Name = wsTemplate.Range("J1")

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
I want each of the copies a separate workbook.

Jason Lepack wrote:
Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

Thank you so much!

I am getting an xls. error message and when I hit ok, it's giving me a
blank book with 2 sheets un-named/un-saved. Any ideas?

NUMBER: 1004
Description:
While renaming a sheet or chart, you entered an invalid name. Try one
of the following:

Make sure the name you entered does not exceed 31 characters.
Make sure the name does not contain any of the following characters: :
\ / ? * [ or ]
Make sure you did not leave the name blank.

Thanks again!

Jason Lepack wrote:
Try this one on, if it has any issues, just post back.

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once oyu hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add
wsNew.Name = wsTemplate.Range("J1")

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
I want each of the copies a separate workbook.

Jason Lepack wrote:
Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

Oh yah, and this is what is populated in J1: '12429 - O. C. Cluss
Lumber Company'

Jess wrote:
Thank you so much!

I am getting an xls. error message and when I hit ok, it's giving me a
blank book with 2 sheets un-named/un-saved. Any ideas?

NUMBER: 1004
Description:
While renaming a sheet or chart, you entered an invalid name. Try one
of the following:

Make sure the name you entered does not exceed 31 characters.
Make sure the name does not contain any of the following characters: :
\ / ? * [ or ]
Make sure you did not leave the name blank.

Thanks again!

Jason Lepack wrote:
Try this one on, if it has any issues, just post back.

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once oyu hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add
wsNew.Name = wsTemplate.Range("J1")

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
I want each of the copies a separate workbook.

Jason Lepack wrote:
Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

Yeah, after you get the error message the program just halts what it
was doing.

Do any of the other names have periods or dashes in them? I oculd
possibly add code to filter them out.

How many did it get through before you get the error?


Jess wrote:
Oh yah, and this is what is populated in J1: '12429 - O. C. Cluss
Lumber Company'

Jess wrote:
Thank you so much!

I am getting an xls. error message and when I hit ok, it's giving me a
blank book with 2 sheets un-named/un-saved. Any ideas?

NUMBER: 1004
Description:
While renaming a sheet or chart, you entered an invalid name. Try one
of the following:

Make sure the name you entered does not exceed 31 characters.
Make sure the name does not contain any of the following characters: :
\ / ? * [ or ]
Make sure you did not leave the name blank.

Thanks again!

Jason Lepack wrote:
Try this one on, if it has any issues, just post back.

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once oyu hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add
wsNew.Name = wsTemplate.Range("J1")

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
I want each of the copies a separate workbook.

Jason Lepack wrote:
Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

They're all going to be a 5 digit number " - " Name. This was the only
one with periods in it. Can I not have - or .? I can change that if
that's the case.

It didn't get through any.

Jason Lepack wrote:
Yeah, after you get the error message the program just halts what it
was doing.

Do any of the other names have periods or dashes in them? I oculd
possibly add code to filter them out.

How many did it get through before you get the error?


Jess wrote:
Oh yah, and this is what is populated in J1: '12429 - O. C. Cluss
Lumber Company'

Jess wrote:
Thank you so much!

I am getting an xls. error message and when I hit ok, it's giving me a
blank book with 2 sheets un-named/un-saved. Any ideas?

NUMBER: 1004
Description:
While renaming a sheet or chart, you entered an invalid name. Try one
of the following:

Make sure the name you entered does not exceed 31 characters.
Make sure the name does not contain any of the following characters: :
\ / ? * [ or ]
Make sure you did not leave the name blank.

Thanks again!

Jason Lepack wrote:
Try this one on, if it has any issues, just post back.

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once oyu hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add
wsNew.Name = wsTemplate.Range("J1")

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
I want each of the copies a separate workbook.

Jason Lepack wrote:
Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

The problem so far was that the name was too long.

Also, are you going to want to keep multiple copies of each of these
files? or is overwriting ok? right now if you run the macro multiple
times it will overwrite the previous files.

Cheers,
Jason Lepack

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once you hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add

' this is the change to fix the names that were too long
If Len(wsTemplate.Range("J1")) 31 Then
wsNew.Name = Left(wsTemplate.Range("J1"), 31)
Else
wsNew.Name = wsTemplate.Range("J1")
End If
' this is the end of the change to fix the file names

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
They're all going to be a 5 digit number " - " Name. This was the only
one with periods in it. Can I not have - or .? I can change that if
that's the case.

It didn't get through any.

Jason Lepack wrote:
Yeah, after you get the error message the program just halts what it
was doing.

Do any of the other names have periods or dashes in them? I oculd
possibly add code to filter them out.

How many did it get through before you get the error?


Jess wrote:
Oh yah, and this is what is populated in J1: '12429 - O. C. Cluss
Lumber Company'

Jess wrote:
Thank you so much!

I am getting an xls. error message and when I hit ok, it's giving me a
blank book with 2 sheets un-named/un-saved. Any ideas?

NUMBER: 1004
Description:
While renaming a sheet or chart, you entered an invalid name. Try one
of the following:

Make sure the name you entered does not exceed 31 characters.
Make sure the name does not contain any of the following characters: :
\ / ? * [ or ]
Make sure you did not leave the name blank.

Thanks again!

Jason Lepack wrote:
Try this one on, if it has any issues, just post back.

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once oyu hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add
wsNew.Name = wsTemplate.Range("J1")

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
I want each of the copies a separate workbook.

Jason Lepack wrote:
Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

Overwriting is fine.
It's Perfect. Thank you so much!!! It works great. Happy New Year!

Jason Lepack wrote:
The problem so far was that the name was too long.

Also, are you going to want to keep multiple copies of each of these
files? or is overwriting ok? right now if you run the macro multiple
times it will overwrite the previous files.

Cheers,
Jason Lepack

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once you hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add

' this is the change to fix the names that were too long
If Len(wsTemplate.Range("J1")) 31 Then
wsNew.Name = Left(wsTemplate.Range("J1"), 31)
Else
wsNew.Name = wsTemplate.Range("J1")
End If
' this is the end of the change to fix the file names

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
They're all going to be a 5 digit number " - " Name. This was the only
one with periods in it. Can I not have - or .? I can change that if
that's the case.

It didn't get through any.

Jason Lepack wrote:
Yeah, after you get the error message the program just halts what it
was doing.

Do any of the other names have periods or dashes in them? I oculd
possibly add code to filter them out.

How many did it get through before you get the error?


Jess wrote:
Oh yah, and this is what is populated in J1: '12429 - O. C. Cluss
Lumber Company'

Jess wrote:
Thank you so much!

I am getting an xls. error message and when I hit ok, it's giving me a
blank book with 2 sheets un-named/un-saved. Any ideas?

NUMBER: 1004
Description:
While renaming a sheet or chart, you entered an invalid name. Try one
of the following:

Make sure the name you entered does not exceed 31 characters.
Make sure the name does not contain any of the following characters: :
\ / ? * [ or ]
Make sure you did not leave the name blank.

Thanks again!

Jason Lepack wrote:
Try this one on, if it has any issues, just post back.

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once oyu hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add
wsNew.Name = wsTemplate.Range("J1")

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
I want each of the copies a separate workbook.

Jason Lepack wrote:
Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

Excellent work posting the error message and the test case that was
currently in use.
These things are always so much easier with real data.

Happy New Year to you as well.

Cheers,
Jason Lepack

Jess wrote:
Overwriting is fine.
It's Perfect. Thank you so much!!! It works great. Happy New Year!

Jason Lepack wrote:
The problem so far was that the name was too long.

Also, are you going to want to keep multiple copies of each of these
files? or is overwriting ok? right now if you run the macro multiple
times it will overwrite the previous files.

Cheers,
Jason Lepack

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once you hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add

' this is the change to fix the names that were too long
If Len(wsTemplate.Range("J1")) 31 Then
wsNew.Name = Left(wsTemplate.Range("J1"), 31)
Else
wsNew.Name = wsTemplate.Range("J1")
End If
' this is the end of the change to fix the file names

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
They're all going to be a 5 digit number " - " Name. This was the only
one with periods in it. Can I not have - or .? I can change that if
that's the case.

It didn't get through any.

Jason Lepack wrote:
Yeah, after you get the error message the program just halts what it
was doing.

Do any of the other names have periods or dashes in them? I oculd
possibly add code to filter them out.

How many did it get through before you get the error?


Jess wrote:
Oh yah, and this is what is populated in J1: '12429 - O. C. Cluss
Lumber Company'

Jess wrote:
Thank you so much!

I am getting an xls. error message and when I hit ok, it's giving me a
blank book with 2 sheets un-named/un-saved. Any ideas?

NUMBER: 1004
Description:
While renaming a sheet or chart, you entered an invalid name. Try one
of the following:

Make sure the name you entered does not exceed 31 characters.
Make sure the name does not contain any of the following characters: :
\ / ? * [ or ]
Make sure you did not leave the name blank.

Thanks again!

Jason Lepack wrote:
Try this one on, if it has any issues, just post back.

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once oyu hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add
wsNew.Name = wsTemplate.Range("J1")

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
I want each of the copies a separate workbook.

Jason Lepack wrote:
Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

:) i'm glad you could help him, jason.........
that would have taken me waaaaaaaay more than 2 hours!!!!
susan

Jason Lepack wrote:
Excellent work posting the error message and the test case that was
currently in use.
These things are always so much easier with real data.

Happy New Year to you as well.

Cheers,
Jason Lepack

Jess wrote:
Overwriting is fine.
It's Perfect. Thank you so much!!! It works great. Happy New Year!

Jason Lepack wrote:
The problem so far was that the name was too long.

Also, are you going to want to keep multiple copies of each of these
files? or is overwriting ok? right now if you run the macro multiple
times it will overwrite the previous files.

Cheers,
Jason Lepack

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once you hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add

' this is the change to fix the names that were too long
If Len(wsTemplate.Range("J1")) 31 Then
wsNew.Name = Left(wsTemplate.Range("J1"), 31)
Else
wsNew.Name = wsTemplate.Range("J1")
End If
' this is the end of the change to fix the file names

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
They're all going to be a 5 digit number " - " Name. This was the only
one with periods in it. Can I not have - or .? I can change that if
that's the case.

It didn't get through any.

Jason Lepack wrote:
Yeah, after you get the error message the program just halts what it
was doing.

Do any of the other names have periods or dashes in them? I oculd
possibly add code to filter them out.

How many did it get through before you get the error?


Jess wrote:
Oh yah, and this is what is populated in J1: '12429 - O. C. Cluss
Lumber Company'

Jess wrote:
Thank you so much!

I am getting an xls. error message and when I hit ok, it's giving me a
blank book with 2 sheets un-named/un-saved. Any ideas?

NUMBER: 1004
Description:
While renaming a sheet or chart, you entered an invalid name. Try one
of the following:

Make sure the name you entered does not exceed 31 characters.
Make sure the name does not contain any of the following characters: :
\ / ? * [ or ]
Make sure you did not leave the name blank.

Thanks again!

Jason Lepack wrote:
Try this one on, if it has any issues, just post back.

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once oyu hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add
wsNew.Name = wsTemplate.Range("J1")

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
I want each of the copies a separate workbook.

Jason Lepack wrote:
Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n

Ok, I have one last question: You have:
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteAll
This copies the cells in the workbook. I also have a logo (image) in
the worksheet that I would like copied over. Any way to do that?

No hurry on this one.

Thanks,

Jessa

Susan wrote:
:) i'm glad you could help him, jason.........
that would have taken me waaaaaaaay more than 2 hours!!!!
susan

Jason Lepack wrote:
Excellent work posting the error message and the test case that was
currently in use.
These things are always so much easier with real data.

Happy New Year to you as well.

Cheers,
Jason Lepack

Jess wrote:
Overwriting is fine.
It's Perfect. Thank you so much!!! It works great. Happy New Year!

Jason Lepack wrote:
The problem so far was that the name was too long.

Also, are you going to want to keep multiple copies of each of these
files? or is overwriting ok? right now if you run the macro multiple
times it will overwrite the previous files.

Cheers,
Jason Lepack

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once you hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add

' this is the change to fix the names that were too long
If Len(wsTemplate.Range("J1")) 31 Then
wsNew.Name = Left(wsTemplate.Range("J1"), 31)
Else
wsNew.Name = wsTemplate.Range("J1")
End If
' this is the end of the change to fix the file names

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
They're all going to be a 5 digit number " - " Name. This was the only
one with periods in it. Can I not have - or .? I can change that if
that's the case.

It didn't get through any.

Jason Lepack wrote:
Yeah, after you get the error message the program just halts what it
was doing.

Do any of the other names have periods or dashes in them? I oculd
possibly add code to filter them out.

How many did it get through before you get the error?


Jess wrote:
Oh yah, and this is what is populated in J1: '12429 - O. C. Cluss
Lumber Company'

Jess wrote:
Thank you so much!

I am getting an xls. error message and when I hit ok, it's giving me a
blank book with 2 sheets un-named/un-saved. Any ideas?

NUMBER: 1004
Description:
While renaming a sheet or chart, you entered an invalid name. Try one
of the following:

Make sure the name you entered does not exceed 31 characters.
Make sure the name does not contain any of the following characters: :
\ / ? * [ or ]
Make sure you did not leave the name blank.

Thanks again!

Jason Lepack wrote:
Try this one on, if it has any issues, just post back.

Sub saveDealerProfiles()
On Error GoTo saveDealerProfiles_Err

Const SAVEDIR = "\\Bpfile1\groups\CCC\Public\Dealer Profiles\"

Dim wbMain As Workbook, wbNew As Workbook
Dim wsTemplate As Worksheet, wsList As Worksheet, wsNew As
Worksheet, ws As Worksheet
Dim r As Range

' the workbook with the template and the list
Set wbMain = ActiveWorkbook
' the worksheet with the template
Set wsTemplate = wbMain.Sheets("Dealer Profile")
' the worksheet with the list
Set wsList = wbMain.Sheets("Dealer List")

' point to the first cell in the list of dealers
Set r = wsList.Range("A2")

' hide the creation of new workbooks
Application.ScreenUpdating = False

' once oyu hit the end of the list there will be blank cells
Do While Not r.Value = ""
' populate the field in the template that the lookups use
wsTemplate.Range("D4").Value = r.Value

' create the new workbook
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets.Add
wsNew.Name = wsTemplate.Range("J1")

' delete all worksheets except for the new one
Application.DisplayAlerts = False
For Each ws In wbNew.Sheets
If Not ws.Name = wsNew.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Nothing

' copy the cells from the template to the new worksheet,
pasting values only
wsTemplate.Cells.Copy
wsNew.Cells.PasteSpecial xlPasteValues

' save the workbook
wbNew.SaveAs SAVEDIR & wsNew.Name & ".xls"

' this pointer will be orphaned after closing the workbook so
remove it
Set wsNew = Nothing

' close the workbook
wbNew.Close

' move to the next cell in the list column
Set r = r.Offset(1, 0)
Loop
MsgBox "Dealer Profiles have been exported to:" & vbCrLf & vbCrLf &
SAVEDIR

' clean up
saveDealerProfiles_Goodbye:
Application.ScreenUpdating = True
Set r = Nothing
Set wsList = Nothing
Set wsTemplate = Nothing
Set wbNew = Nothing
Set wbMain = Nothing
Exit Sub
' hits here if there's an error
saveDealerProfiles_Err:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "Description:" & vbCrLf &
Err.Description
Resume saveDealerProfiles_Goodbye
End Sub

Jess wrote:
I want each of the copies a separate workbook.

Jason Lepack wrote:
Ok that makes much more sense.

Now, you want each of these template copies in a new workbook? Or do
you want them just on seperate sheets in the same workbook?


Jess wrote:
I tried an If statement and I cant get it to work. I have 2 tabs. One
is Dealer List. It contains a Dealer ID Number, Name, Address, Phone,
Fax, etc... The other is Dealer Profile which is a form template. I
have vlookups on the Dealer template that populate Address, Name
information when a dealer number is populated into cell D4 (DealerNum)
which in turns populates some NAme/Adddress information within the
template. What I'm trying to do is write a code that takes the Dealer
ID Number from column A in my Dealer List tab populate D4 with it, make
a copy of the tab, break the links, save the copy to a specified
location, close the workbook, then take the next Dealer ID Number in
column A and populate the template again in a loop until it comes
accross a blank cell in column A of the Dealer List tab.

Jason Lepack wrote:
What exactly would you like this to do? List step by step instructions
on what you need and list cell and worksheet(tab) locations of all the
important information.

Cheers,
Jason Lepack


Jess wrote:
I am having a problem with looping. Basically I am trying to pull one
number from a list on a separate tab, put it in a cell in template form
and save it and then take the next number in the list and populate it
in the same cell in the template. The way I'm doing it, it's saveing a
workbook for every number between the first number in my list and the
last rather than every number that is populated in the cell... If that
makes sence. Can anyone help? (Go easy on my, I'm new)

Sheets("Dealer List").Select
For n = Range("A2") To Range("A48")
Range("D4") = n

Sheets("Dealer Profile").Select
Sheets("Dealer Profile").Copy
Range("C4:H7").Select
Range("D4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Shapes("Button 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Button 3").Select
Application.CutCopyMode = False
Selection.Delete
Dim FileN
FileN = Range("J1")
ChDir "\\Bpfile1\groups\CCC\Public\Dealer Profiles"
ActiveWorkbook.SaveAs FileName:= _
FileN, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

Next n