My Goal is to copy the cells A1:AB10 "EXACTLY" as they are. Including
Formatting, cell sizes, and Formulas. I added the ".Formula" because my fist
attempt was coping the value and not the formula, but now if is not coping
the cell sizes and formatting (including conditional formatting). Note that
the target Worksheet will be new so no pre-exiting formatting can be done.
Is this possible?

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Set NewBettingWS = Worksheets.Add
With NewBettingWS
.Name = "NewBettingWS"
ActiveSheet.Unprotect
ActiveSheet.Range("A1:AB10").Formula =
Sheets(BettingTemplateSource).Range("A1:AB10").For mula
ActiveSheet.Protect
ActiveWorkbook.Save
End With
End If

CRayF -

Maybe you could use the VBA equivalent of Edit | Move Or Copy Sheets |
Create A Copy, and then delete the rows and columns of the new worksheet
that you don't want to include.

- Mike
www.mikemiddleton.com

"CRayF" wrote in message
...
My Goal is to copy the cells A1:AB10 "EXACTLY" as they are. Including
Formatting, cell sizes, and Formulas. I added the ".Formula" because my
fist
attempt was coping the value and not the formula, but now if is not coping
the cell sizes and formatting (including conditional formatting). Note
that
the target Worksheet will be new so no pre-exiting formatting can be done.
Is this possible?

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Set NewBettingWS = Worksheets.Add
With NewBettingWS
.Name = "NewBettingWS"
ActiveSheet.Unprotect
ActiveSheet.Range("A1:AB10").Formula =
Sheets(BettingTemplateSource).Range("A1:AB10").For mula
ActiveSheet.Protect
ActiveWorkbook.Save
End With
End If

I think Mike's suggestion may be the best way to proceded with this as I
don't know of any easy way to copy conditional formatting. Something
like this;

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim eCol As Integer
Dim eRow As Long

Sheets("BettingTemplateSource").Copy befo=Sheets(1)
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = "NewBettingWS"
.Unprotect
eCol = .Cells(1, Columns.Count).End(xlToLeft).Column
eRow = .Cells(Rows.Count, 1).End(xlUp).Row
If eCol 28 Then
.Range(.Cells(1, 29), .Cells(1, eCol)).EntireColumn.Delete
End If
If eRow 10 Then Rows("11:" & eRow).Delete
.Protect
ActiveWorkbook.Save
End With
End If

CRayF wrote:
My Goal is to copy the cells A1:AB10 "EXACTLY" as they are. Including
Formatting, cell sizes, and Formulas. I added the ".Formula" because my fist
attempt was coping the value and not the formula, but now if is not coping
the cell sizes and formatting (including conditional formatting). Note that
the target Worksheet will be new so no pre-exiting formatting can be done.
Is this possible?

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Set NewBettingWS = Worksheets.Add
With NewBettingWS
.Name = "NewBettingWS"
ActiveSheet.Unprotect
ActiveSheet.Range("A1:AB10").Formula =
Sheets(BettingTemplateSource).Range("A1:AB10").For mula
ActiveSheet.Protect
ActiveWorkbook.Save
End With
End If

I took out the deletes and it at least copied all the cells with formulas.

I was hoping to trim the template down to just the 22 rows and repeat the
last 12 over and aver again onto the new Worksheet. The first 10 rows are
"like a header" and then the next 12 rows starting in row 11 (rows 11-22)
would be copied to the new worksheet with the header (rows 1-10) and
replicate rows 11-22 again to 23-34, then 35-46, etc...
Is it safe to assume that this can't be done?
At least this is a start...



If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim eCol As Integer
Dim eRow As Long

Sheets(BettingTemplateSource).Copy befo=Sheets(1)
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = Format(Sheets(ProgramDataInput). _
Range("F3").Value, "mm-dd-yy ") & _
Left(Sheets(ProgramDataInput).Range("H3").Value, 3)

.Unprotect
eCol = .Cells(1, Columns.Count).End(xlToLeft).Column
eRow = .Cells(Rows.Count, 1).End(xlUp).Row
If eCol 28 Then
.Range(.Cells(1, 29), .Cells(1, eCol)).EntireColumn.Delete
End If
If eRow 10 Then Rows("11:" & eRow).Delete
.Protect
ActiveWorkbook.Save
End With
End If



"Rowan" wrote:

I think Mike's suggestion may be the best way to proceded with this as I
don't know of any easy way to copy conditional formatting. Something
like this;

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim eCol As Integer
Dim eRow As Long

Sheets("BettingTemplateSource").Copy befo=Sheets(1)
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = "NewBettingWS"
.Unprotect
eCol = .Cells(1, Columns.Count).End(xlToLeft).Column
eRow = .Cells(Rows.Count, 1).End(xlUp).Row
If eCol 28 Then
.Range(.Cells(1, 29), .Cells(1, eCol)).EntireColumn.Delete
End If
If eRow 10 Then Rows("11:" & eRow).Delete
.Protect
ActiveWorkbook.Save
End With
End If

CRayF wrote:
My Goal is to copy the cells A1:AB10 "EXACTLY" as they are. Including
Formatting, cell sizes, and Formulas. I added the ".Formula" because my fist
attempt was coping the value and not the formula, but now if is not coping
the cell sizes and formatting (including conditional formatting). Note that
the target Worksheet will be new so no pre-exiting formatting can be done.
Is this possible?

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Set NewBettingWS = Worksheets.Add
With NewBettingWS
.Name = "NewBettingWS"
ActiveSheet.Unprotect
ActiveSheet.Range("A1:AB10").Formula =
Sheets(BettingTemplateSource).Range("A1:AB10").For mula
ActiveSheet.Protect
ActiveWorkbook.Save
End With
End If

You don't say how many times you want to repeat the rows but maybe
something like this (repeates 10 times).

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim i As Integer

Sheets("BettingTemplateSource").Copy befo=ActiveSheet
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = "NewBettingWS"
.Unprotect
.Tab.ColorIndex = 3 'or replace with index number
For i = 0 To 9
.Rows("11:22").Copy .Cells((i * 12) + 23, 1)
Next i
.Protect
ActiveWorkbook.Save
End With
End If

Regards
Rowan

CRayF wrote:
I took out the deletes and it at least copied all the cells with formulas.

I was hoping to trim the template down to just the 22 rows and repeat the
last 12 over and aver again onto the new Worksheet. The first 10 rows are
"like a header" and then the next 12 rows starting in row 11 (rows 11-22)
would be copied to the new worksheet with the header (rows 1-10) and
replicate rows 11-22 again to 23-34, then 35-46, etc...
Is it safe to assume that this can't be done?
At least this is a start...



If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim eCol As Integer
Dim eRow As Long

Sheets(BettingTemplateSource).Copy befo=Sheets(1)
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = Format(Sheets(ProgramDataInput). _
Range("F3").Value, "mm-dd-yy ") & _
Left(Sheets(ProgramDataInput).Range("H3").Value, 3)

.Unprotect
eCol = .Cells(1, Columns.Count).End(xlToLeft).Column
eRow = .Cells(Rows.Count, 1).End(xlUp).Row
If eCol 28 Then
.Range(.Cells(1, 29), .Cells(1, eCol)).EntireColumn.Delete
End If
If eRow 10 Then Rows("11:" & eRow).Delete
.Protect
ActiveWorkbook.Save
End With
End If



"Rowan" wrote:


I think Mike's suggestion may be the best way to proceded with this as I
don't know of any easy way to copy conditional formatting. Something
like this;

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim eCol As Integer
Dim eRow As Long

Sheets("BettingTemplateSource").Copy befo=Sheets(1)
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = "NewBettingWS"
.Unprotect
eCol = .Cells(1, Columns.Count).End(xlToLeft).Column
eRow = .Cells(Rows.Count, 1).End(xlUp).Row
If eCol 28 Then
.Range(.Cells(1, 29), .Cells(1, eCol)).EntireColumn.Delete
End If
If eRow 10 Then Rows("11:" & eRow).Delete
.Protect
ActiveWorkbook.Save
End With
End If

CRayF wrote:

My Goal is to copy the cells A1:AB10 "EXACTLY" as they are. Including
Formatting, cell sizes, and Formulas. I added the ".Formula" because my fist
attempt was coping the value and not the formula, but now if is not coping
the cell sizes and formatting (including conditional formatting). Note that
the target Worksheet will be new so no pre-exiting formatting can be done.
Is this possible?

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Set NewBettingWS = Worksheets.Add
With NewBettingWS
.Name = "NewBettingWS"
ActiveSheet.Unprotect
ActiveSheet.Range("A1:AB10").Formula =
Sheets(BettingTemplateSource).Range("A1:AB10"). Formula
ActiveSheet.Protect
ActiveWorkbook.Save
End With
End If

Nice Job.
You don't say how many times you want to repeat the rows

Can this be done as long as a cell tests empty?

The purpose of this is when the cell on the BettingTemplateSource Worksheet
(Source) is selected this code would create a NEW Race Track Worksheet named
€œmm-dd-yy rrr€� ex. 09-21-05 PHX (Phoenix) from data on the main Worksheet
called ProgramDataInput Worksheet (TXT Imported). And is created on the next
TAB to the left of the Active Woorksheet and give it a color TAB. (Very Nice
Job - Thanks) .

The intent of the BettingTemplateSource Worksheet was I could use it as a
master, and dish out the new Worksheet's for each race using the
BettingTemplateSource Worksheet as its source. Your code you so elegantly
crafted below does exactly that.

The perfect scenario would be for the LOOP to END when one of the matching
cell numbers from the ProgramDataInput worksheet tests empty. So each time
through the LOOP the €œA1€� cell (, A13, A25, A37, A49, etc) is tested for
empty, and if so, then terminate the coping.

How hard would it be in implement testing for a cell value?

This is what I understand:
We want to create a new sheet called NewBettingWs.
Rows 1 to 10 of this sheet will be the same as rows one to ten in the
sheet BettingTemplateSource.
Then we will copy over rows 11 to 22 of the BettingTemplateSource sheet
repeatedly to mirror the number of groups (12 rows per group) on the
ProgramDataInput sheet starting in cell A13.

Maybe like this:

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim srcSht As Worksheet
Dim i As Integer
Dim j As Integer
Dim src As Variant

Set srcSht = Sheets("ProgramDataInput")

Sheets("BettingTemplateSource").Copy befo=ActiveSheet
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = "NewBettingWS"
.Unprotect
.Tab.ColorIndex = 3
src = srcSht.Range("A13").Value
i = 13
j = 0
Do Until src = ""
.Rows("11:22").Copy .Cells((j * 12) + 23, 1)
i = i + 12
j = j + 1
src = srcSht.Cells(i, 1).Value
Loop
.Protect
ActiveWorkbook.Save
End With
End If

Regards
Rowan

CRayF wrote:
Nice Job.

You don't say how many times you want to repeat the rows


Can this be done as long as a cell tests empty?

The purpose of this is when the cell on the BettingTemplateSource Worksheet
(Source) is selected this code would create a NEW Race Track Worksheet named
€œmm-dd-yy rrr€� ex. 09-21-05 PHX (Phoenix) from data on the main Worksheet
called ProgramDataInput Worksheet (TXT Imported). And is created on the next
TAB to the left of the Active Woorksheet and give it a color TAB. (Very Nice
Job - Thanks) .

The intent of the BettingTemplateSource Worksheet was I could use it as a
master, and dish out the new Worksheet's for each race using the
BettingTemplateSource Worksheet as its source. Your code you so elegantly
crafted below does exactly that.

The perfect scenario would be for the LOOP to END when one of the matching
cell numbers from the ProgramDataInput worksheet tests empty. So each time
through the LOOP the €œA1€� cell (, A13, A25, A37, A49, etc) is tested for
empty, and if so, then terminate the coping.

How hard would it be in implement testing for a cell value?

hummm I've learned allot from analyzing your code and modified the entire
module using this style so there are many cosmetic changes Also, I noticed it
was more efficient to use the "srcProgramDataInputWs" as the one to test for
the null value . This worksheet is also is a multiple of 12 rows but the Race
€œ1€� is in B3 instead of A12. €œi€� starts out as €œ3€� then adds 12 to it and
firsts test B15 for null. (B15=2; B27=3; B39=4, etc.)

Now this works Except it copies one too many rows. The last cell to test
FALSE for null is B171 which = 15 and then B183 indeed contains null.

I added a MsgBox to display "src" (see below) and the last popup says 15,
but it appears to continue onto complete the last copy.

Any clues why it copies one too many rows?
I am just getting started with VBA but I know in REXX there are 2 types of
loops that do almost the same thing; Do UNTIL; and DO WHILE where the UNTIL
terminated at the top of the loop and the WHILE terminates on the end of the
loop. Does VBA compare?

Here is the code again with the MANY changes for references but using your
code, now works, just copies one too many sets.
-------------------------------------------
Dim srcProgramDataInputWs As Worksheet
Dim srcProgramSummaryTemplateWs As Worksheet
Dim srcProgramSummaryWs As Worksheet
Dim srcBettingTemplateWs As Worksheet
Dim racePark As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer

Set srcProgramSummaryTemplateWs = Sheets("@TemplateProgramSummary")
Set srcProgramSummaryWs = Sheets("ProgramSummary")
Set srcBettingTemplateWs = Sheets("@TempleteBetting")
Set srcProgramDataInputWs = Sheets("ProgramDataInput")
racePark = Left(srcProgramDataInputWs.Range("H3").Value, 3)

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim NewWSTabColor As Variant
Dim src As Variant

If racePark = "PHX" Then NewWSTabColor = 10
If racePark = "WHE" Then NewWSTabColor = 46
If racePark = "WON" Then NewWSTabColor = 41

srcBettingTemplateWs.Copy befo=ActiveSheet
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = Format(srcProgramDataInputWs. _
Range("F3").Value, "mm-dd-yy ") & _
Left(srcProgramDataInputWs.Range("H3").Value, 3)
.Unprotect
.Tab.ColorIndex = NewWSTabColor 'or replace with index number

src = srcProgramDataInputWs.Range("B3").Value
i = 3
j = 0
Do Until src = ""
If MsgBox(src, vbYesNo) = vbYes Then
End If
srcBettingTemplateWs.Rows("11:22").Copy .Cells((j * 12) + 23, 1)
i = i + 12
j = j + 1
src = srcProgramDataInputWs.Cells(i, 2).Value
Loop

.Protect
End With
End If
-------------------------------------------

Terrific, I see where you modified the starting row of from 23to 11. That
help me understand how you coded the loop as well. Now Im into tweak mode. I
actually used this for the first time tonight on the Phoenix Greyhound races.
I would say this has been a fun €œfirst€� VBA/Excel project for me but as a
true programmer at heart, Ive got idea/enhancements already€¦ ;-) thanks
again. (And thanks for the €œloop€� code reference below. Ive save that off.
Is there a good course for some books (URL Links) that show these €œcommand€�
references? Parms associated with it and examples of it being put to use. Key
variables like Application, Worksheet, Value, Cell, Range, etc€¦ Id like to
learn this stuff more.

There a a lot of good books on Excel VBA - look on amazon for the author
John Walkenbach or see www.j-walk.com.

Also have a browse through the Excel Visual Basic help in the VBE. It is
actually quite extensive and has the Excel Object Model in a visual
format which includes all the excel objects eg worksheets, ranges etc.
The section titled Visual Basic conceptual topics has details of loops,
using variables, if..then statements ans so on.

Good luck
Rowan

CRayF wrote:
Terrific, I see where you modified the starting row of from 23to 11. That
help me understand how you coded the loop as well. Now Im into tweak mode. I
actually used this for the first time tonight on the Phoenix Greyhound races.
I would say this has been a fun €œfirst€� VBA/Excel project for me but as a
true programmer at heart, Ive got idea/enhancements already€¦ ;-) thanks
again. (And thanks for the €œloop€� code reference below. Ive save that off.
Is there a good course for some books (URL Links) that show these €œcommand€�
references? Parms associated with it and examples of it being put to use. Key
variables like Application, Worksheet, Value, Cell, Range, etc€¦ Id like to
learn this stuff more.