Adding a column that has format

  • Thread starter Thread starter Steve L.
  • Start date Start date
S

Steve L.

I want to add columns that automatically copy the format and properties of
the previous column. I have a heading that is numbered and would like it go
to the next number. A running total that refers to a fixed cell. Colors. I
can do most of this with a macro but I have cells that I want the new cells
in the newly added columns to be added to the sum. (scratch)
 
I'm not quite sure how all this fits together. But to get started, couldn't you
record a macro that inserts a new column, copies the previous column and
paste|special formats?

And you could include something to increment the header.

Option Explicit
Sub testme01()

Dim myRng As Range
Dim myCol As Long

Set myRng = Nothing
On Error Resume Next
Set myRng = Application.InputBox(Prompt:="Select the column to insert", _
Type:=8)
On Error GoTo 0

If myRng Is Nothing Then
Exit Sub
End If

Set myRng = myRng(1) 'just in case more than one cell was selected.

myCol = myRng.Column

If myCol = 1 Then
MsgBox "I can't copy from the left of this column!"
Exit Sub
End If

With myRng.Parent
.Columns(myCol).Insert
.Columns(myCol - 1).Copy
.Columns(myCol).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

If IsNumeric(.Cells(1, myCol - 1).Value) Then
.Cells(1, myCol).Value = .Cells(1, myCol - 1).Value + 1
End If
End With

Application.CutCopyMode = False

End Sub

If you're new to macros, you may want to read David's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

For what it's worth, when I insert a column in xl2002, it sure looks like the
new column inherits the format (fill color, font color, numberformat) from that
column on its left.

So if your version of excel does this, too (I don't recall it at all), then this
might be completely overkill!
 
Dave Peterson said:
I'm not quite sure how all this fits together. But to get started,
couldn't you record a macro that inserts a new column, copies the
previous column and paste|special formats?
Click to expand...
OK so I recorded a macro that loolks like this

Sub Macro2()
'
' Macro2 Macro
' Macro recorded 3/12/2004 by Steve
'

'
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
Selection.Copy
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:
=False _
, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Offset(4, 0).Range("A1").Select
End Sub

This works OK but I would like it to be totally automated for the dummies
in the office. I'm not totally green to recording macros and I don't have
time to learn VBA at least not at the moment. The thing I want to do is
always select the last column with numbered headings and paste it after
the next available number in the heading. How can get it to always select
the column just before the last one. It would be nice if I can get this
to work with one click.
 
I'm kind of confused about the "next available number in the heading".

You can find the lastused column in row 1 by:

Dim LastCol As Long
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

But if you have to check for numeric entries, you have to do more. You could
loop backwards or you could look for numerics and just take the last cell in
that range of specialcells.

Option Explicit
Sub testme01()

Dim myCol As Long
Dim myRng As Range

With ActiveSheet

Set myRng = Nothing
On Error Resume Next
Set myRng = .Rows(1).Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "no numeric cells found in row 1!"
Exit Sub
End If

With myRng
With .Areas(.Areas.Count)
myCol = .Cells(.Cells.Count).Column
End With
End With

If myCol = 1 Then
MsgBox "I can't copy from the left of this column!"
Exit Sub
End If

.Columns(myCol + 1).Insert
.Columns(myCol).Copy
.Columns(myCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.Cells(1, myCol + 1).Value = .Cells(1, myCol).Value + 1

.Cells(1, myCol + 1).Select
End With

Application.CutCopyMode = False

End Sub


=====
I'm not sure if you saw the code in the previous post, but that allowed the user
to select a cell where the new column should go.

(it might be useful sometime.)
 
I don't open attachments.

Can you use the lastcol suggestion

At the top of your existing code to find the right most column?
 
Dave Peterson said:
I don't open attachments.
Click to expand...

Attachment? Suppossed to be a link to my website. Nothing bad will happen.
If I make a .jpg or .gif would you look at that? There's nothing more on my
site than an "Under Construction" page and the .pdf.
 
Dave Peterson said:
Can you use the lastcol suggestion


At the top of your existing code to find the right most column?
Click to expand...

BTW. Thanks for not yelling at me for being stupid and vague. I'm not sure
how to accurately describe what I want to happen.
 
Each post to the newsgroup is archived in google. If you explain in plain text,
then your post (and suggestions) will be kept there for people who may need the
same kind of solution.

But google won't archive attachments and your pdf documents and web pages are
probably temporary and won't get archived either. So those links/attachments
won't help anyone who's searching later.

And I try not to open attachments or click on links to other stuff. Lots of bad
stuff can happen and I'm not (usually) willing to take the risk--no matter how
small.

That said, I clicked on your web link (bad Dave!).

It looks like your headers are in Row 4. And you want to insert between the
last used column and the next to last used column.

I don't see how the numbered heading and adding 1 fits in.

But this might be closer to what you want.

Option Explicit
Sub testme01()

Dim myCol As Long

With ActiveSheet
myCol = .Cells(4, .Columns.Count).End(xlToLeft).Column - 1

If myCol = 1 Then
MsgBox "I can't copy from the left of this column!"
Exit Sub
End If

.Columns(myCol + 1).Insert
.Columns(myCol).Copy
.Columns(myCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.Cells(1, myCol + 1).Select
End With

Application.CutCopyMode = False

End Sub

Notice that the myCol (I renamed it from LastCol to match the existing code) now
uses:
..cells(4,.columns.count).end(xltoleft).column -1

That 4 means row 4.
the .columns.count means 256, the .end(xltoleft) is like going to IV4 and
hitting End, then left arrow.

It'll take you to the last used cell in that row. Then I subtract to go back
one more.

I dropped the stuff about adding 1 since I didn't see that in your page.

If this is wrong, please take the time to describe what you want in plain text.

(I don't like breaking my rules <vbg>.)
 
Ok. For the benefit of Googlers what I want to do is use a button assigned
to a macro to insert a column before the last column with data to match the
properties of the column that is before the last column currently. The data
in the new column should also be part of the sum in C6:C70. This column
will always be in that range (absolute). The Numbered heading (A/W #1, A/W
#2, etc.) of the new columns should increment to the next available number.
The title above the heading (wrong I know) can be blank.


Q and A inline. Check notes for errors recieved.


Dave Peterson said:
I don't see how the numbered heading and adding 1 fits in.
Click to expand...

The column with the label A/W #1 is where I want to start adding columns
with subsequent labels ie: A/W #2, A/W #3 etc. as needed.
Some jobs only have few A/Ws (Additional Work) and some have as many as 80
or so. So it would ideal to have this work dynamically.

Check below for errors
But this might be closer to what you want.

Option Explicit
Sub testme01()

Dim myCol As Long

With ActiveSheet
myCol = .Cells(4, .Columns.Count).End(xlToLeft).Column - 1

If myCol = 1 Then
MsgBox "I can't copy from the left of this column!"
Exit Sub
End If

.Columns(myCol + 1).Insert
.Columns(myCol).Copy 'I get an error here "Run time
Click to expand...
error 1004 Application defined or object defined error"

.Columns(myCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.Cells(1, myCol + 1).Select
End With

Application.CutCopyMode = False

End Sub
Click to expand...

New columns are being added to the left of the first column instead before
the last column.
 
Next attempt:

Option Explicit
Sub testme01()

Dim myCol As Long
Dim NextNumber As Long

With ActiveSheet
myCol = .Cells(5, .Columns.Count).End(xlToLeft).Column

Do
If LCase(.Cells(5, myCol).Value) Like "a/w [#]*" Then
'stop looking
NextNumber = CLng(Mid(.Cells(5, myCol).Value, 6)) + 1
Exit Do
Else
If myCol = 1 Then
MsgBox "No a/w #'s found in row 5"
Exit Sub
End If
myCol = myCol - 1
End If
Loop

If myCol = 1 Then
MsgBox "I can't copy from the left of this column!"
Exit Sub
End If

.Columns(myCol + 1).Insert
.Columns(myCol).Copy
.Columns(myCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.Cells(5, myCol + 1).Value = "A/W #" & NextNumber

.Cells(1, myCol + 1).Select
End With

Application.CutCopyMode = False

End Sub

And I'd change the formula in C6:c70 to something that either expands
dynamically or checks for "A/W #" in row 5. (Notice the space in the "a/w
#"--in the code, too.)

Put this in C6 and drag down:
=SUMPRODUCT(--(LEFT($D$5:$IV$5,5)="a/w #"),D6:IV6)
 
Dave!
Your code for adding the columns works as expected but the
formula in column C7:C77 you posted leaves a #VALUE error.
All it should do is add columns E7:E77 plus all the A/Ws in the same
range. I tried to tweak it but I'm lost.
Is there tutorial out there that explains how to include a dynamic range? It
would be nice if I could at least understand the some of what I'm looking
at.

Dave Peterson said:
Next attempt:

Option Explicit
Sub testme01()

Dim myCol As Long
Dim NextNumber As Long

With ActiveSheet
myCol = .Cells(5, .Columns.Count).End(xlToLeft).Column

Do
If LCase(.Cells(5, myCol).Value) Like "a/w [#]*" Then
'stop looking
NextNumber = CLng(Mid(.Cells(5, myCol).Value, 6)) + 1
Exit Do
Else
If myCol = 1 Then
MsgBox "No a/w #'s found in row 5"
Exit Sub
End If
myCol = myCol - 1
End If
Loop

If myCol = 1 Then
MsgBox "I can't copy from the left of this column!"
Exit Sub
End If

.Columns(myCol + 1).Insert
.Columns(myCol).Copy
.Columns(myCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.Cells(5, myCol + 1).Value = "A/W #" & NextNumber

.Cells(1, myCol + 1).Select
End With

Application.CutCopyMode = False

End Sub

And I'd change the formula in C6:c70 to something that either expands
dynamically or checks for "A/W #" in row 5. (Notice the space in the "a/w
#"--in the code, too.)

Put this in C6 and drag down:
=SUMPRODUCT(--(LEFT($D$5:$IV$5,5)="a/w #"),D6:IV6)



Steve L. said:
Ok. For the benefit of Googlers what I want to do is use a button assigned
to a macro to insert a column before the last column with data to match the
properties of the column that is before the last column currently. The data
in the new column should also be part of the sum in C6:C70. This column
will always be in that range (absolute). The Numbered heading (A/W #1, A/W
#2, etc.) of the new columns should increment to the next available number.
The title above the heading (wrong I know) can be blank.

Q and A inline. Check notes for errors recieved.



The column with the label A/W #1 is where I want to start adding columns
with subsequent labels ie: A/W #2, A/W #3 etc. as needed.
Some jobs only have few A/Ws (Additional Work) and some have as many as 80
or so. So it would ideal to have this work dynamically.

Check below for errors

error 1004 Application defined or object defined error"


New columns are being added to the left of the first column instead before
the last column.
go
back plain
text.
Click to expand...
Click to expand...
 
Do you have error values in the cells that are referred to in those formulas?

If you do, then you could either clean up the errors or modify the formula:

One way to modify the formula is like this:
=SUMPRODUCT(--(LEFT($D$5:$IV$5,5)="a/w #"),IF(ISNUMBER(D6:IV6),D6:IV6))
This is an array formula. Hit ctrl-shift-enter instead of enter. If you do it
correctly, excel will wrap curly brackets {} around your formula. (don't type
them yourself.

Debra Dalgleish has some notes about dynamic ranges at:
http://www.contextures.com/xlNames01.html#Dynamic






Steve L. said:
Dave!
Your code for adding the columns works as expected but the
formula in column C7:C77 you posted leaves a #VALUE error.
All it should do is add columns E7:E77 plus all the A/Ws in the same
range. I tried to tweak it but I'm lost.
Is there tutorial out there that explains how to include a dynamic range? It
would be nice if I could at least understand the some of what I'm looking
at.

Dave Peterson said:
Next attempt:

Option Explicit
Sub testme01()

Dim myCol As Long
Dim NextNumber As Long

With ActiveSheet
myCol = .Cells(5, .Columns.Count).End(xlToLeft).Column

Do
If LCase(.Cells(5, myCol).Value) Like "a/w [#]*" Then
'stop looking
NextNumber = CLng(Mid(.Cells(5, myCol).Value, 6)) + 1
Exit Do
Else
If myCol = 1 Then
MsgBox "No a/w #'s found in row 5"
Exit Sub
End If
myCol = myCol - 1
End If
Loop

If myCol = 1 Then
MsgBox "I can't copy from the left of this column!"
Exit Sub
End If

.Columns(myCol + 1).Insert
.Columns(myCol).Copy
.Columns(myCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.Cells(5, myCol + 1).Value = "A/W #" & NextNumber

.Cells(1, myCol + 1).Select
End With

Application.CutCopyMode = False

End Sub

And I'd change the formula in C6:c70 to something that either expands
dynamically or checks for "A/W #" in row 5. (Notice the space in the "a/w
#"--in the code, too.)

Put this in C6 and drag down:
=SUMPRODUCT(--(LEFT($D$5:$IV$5,5)="a/w #"),D6:IV6)



Steve L. said:
Ok. For the benefit of Googlers what I want to do is use a button assigned
to a macro to insert a column before the last column with data to match the
properties of the column that is before the last column currently. The data
in the new column should also be part of the sum in C6:C70. This column
will always be in that range (absolute). The Numbered heading (A/W #1, A/W
#2, etc.) of the new columns should increment to the next available number.
The title above the heading (wrong I know) can be blank.

Q and A inline. Check notes for errors recieved.


I don't see how the numbered heading and adding 1 fits in.

The column with the label A/W #1 is where I want to start adding columns
with subsequent labels ie: A/W #2, A/W #3 etc. as needed.
Some jobs only have few A/Ws (Additional Work) and some have as many as 80
or so. So it would ideal to have this work dynamically.

Check below for errors


But this might be closer to what you want.

Option Explicit
Sub testme01()

Dim myCol As Long

With ActiveSheet
myCol = .Cells(4, .Columns.Count).End(xlToLeft).Column - 1

If myCol = 1 Then
MsgBox "I can't copy from the left of this column!"
Exit Sub
End If

.Columns(myCol + 1).Insert
.Columns(myCol).Copy 'I get an error here "Run time
error 1004 Application defined or object defined error"

.Columns(myCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.Cells(1, myCol + 1).Select
End With

Application.CutCopyMode = False

End Sub

New columns are being added to the left of the first column instead before
the last column.


Notice that the myCol (I renamed it from LastCol to match the existing
code) now
uses:
.cells(4,.columns.count).end(xltoleft).column -1

That 4 means row 4.
the .columns.count means 256, the .end(xltoleft) is like going to IV4 and
hitting End, then left arrow.

It'll take you to the last used cell in that row. Then I subtract to go
back
one more.

I dropped the stuff about adding 1 since I didn't see that in your page.

If this is wrong, please take the time to describe what you want in plain
text.

(I don't like breaking my rules <vbg>.)

:


I don't open attachments.


OK, so I made it a regular .html page
Have a look?

http://www.kraftworksremodel.com/Estimate vs actual.htm

Thanks Dave.

Someday the light bulb will power up above my head.
Click to expand...
Click to expand...
Click to expand...
 
One way to modify the formula is like this:
=SUMPRODUCT(--(LEFT($D$5:$IV$5,5)="a/w #"),IF(ISNUMBER(D6:IV6),D6:IV6))
Click to expand...
OK. Just to prove to you that I'm not lazy I did some searching and learning
to figure out what is going on in your formula.

Why did you use SUMPRODUCT? From what I understand that formula wants to
multiply and then add. BTW the cell references on my web site are incorrect.
Using your formula I tweaked it thusly:
=SUM(--(LEFT($F$6:$IV$6,7)="A/W # "),IF(ISNUMBER($E$7:IV7),E7:IV7))
Notice I added a space after the #. Don't now why.
The only problem I have now is the "Margin" column. The formula there is:
= IF(C7=0,"",1-D7/C7)
It is at the end of the "A/W" columns and is being included in C7,
resulting in a circular reference error.
Is there a way to exclude the last column? Remember that its position will
change when new "A/W" columns are added.
 
First watch your references.

If this works ok for you, you'll want to change $e$7 in that isnumber()
portion. And you'll want to make sure each of those start in the same column.
Sometimes you start in column F ($F$6) and sometimes column E E7:IV7.

But put your corrected formula in a test cell. Then put my suggested formula in
the one right below.

Now go up to one of the headers (say A/W #2) and delete it.

How did the formulas evaluate?

=SUMPRODUCT(--(LEFT($D$5:$IV$5,5)="a/w #"),IF(ISNUMBER(D6:IV6),D6:IV6))

The sumproduct version looked at that range and would only add the numbers if
the header started with "a/w #".

It was actually multiplying 1's or 0's by the numbers. Then summing those up.

left($d$5:$iv$5,5)="a/w #"
evaluates to a series of true/falses. The first - sign converts it to -1/0's.
And the other - sign converts the -1's to +1's.

If you only have columns you want to add between the first and last, you can get
rid of the sumproduct and use something like:

=SUM(D6:OFFSET(H6,0,-1))

Where H is the first column to be ignored. Excel will adjust that formula if
you insert a new column to the left of column H.

I don't understand where the formula that's giving you a circular reference is
located or what it should be based on.

Sorry.
 
=SUMPRODUCT(--(LEFT($D$5:$IV$5,5)="a/w #"),IF(ISNUMBER(D6:IV6),D6:IV6))
I can't get this one to work. If I don't get an error I get a blank cell. It
certainly looks like it should though.
Aaaanyhooo.
=SUM(D6:OFFSET(H6,0,-1))
This one does so at least I'm getting closer.
Now, back to the other code.
I didn't notice before but It's not copying the formulas. It does everything
lse beautifully though.
This is the code you posted.

Option Explicit
Sub testme01()

Dim myCol As Long
Dim NextNumber As Long

With ActiveSheet
myCol = .Cells(6, .Columns.Count).End(xlToLeft).Column

Do
If LCase(.Cells(6, myCol).Value) Like "a/w [#]*" Then
'stop looking
NextNumber = CLng(Mid(.Cells(6, myCol).Value, 6)) + 1
Exit Do
Else
If myCol = 1 Then
MsgBox "No a/w #'s found in row 6"
Exit Sub
End If
myCol = myCol - 1
End If
Loop

If myCol = 1 Then
MsgBox "I can't copy from the left of this column!"
Exit Sub
End If

.Columns(myCol + 1).Insert
.Columns(myCol).Copy
.Columns(myCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.Cells(6, myCol + 1).Value = "A/W #" & NextNumber

.Cells(1, myCol + 1).Select
End With

Application.CutCopyMode = False

End Sub


I assume your code is copying and then paste special. It should copy all of
column F's properties but it's not getting the total for each column and
the running total. The total for each column is row 81 and the running total
is row 84. This is the only thing left to figure out before I bake you a
cake.
Thanks again dave.
 
I thought you said formats--not formulas.

These lines:
.Columns(myCol).Copy
.Columns(myCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Paste the formats (note the paste:= value).

This version just copies the column and insert it to the right.

Then it wipes out the constants (from row 7 to the bottom).

Option Explicit
Sub testme01()

Dim myCol As Long
Dim NextNumber As Long

With ActiveSheet
myCol = .Cells(6, .Columns.Count).End(xlToLeft).Column

Do
If LCase(.Cells(6, myCol).Value) Like "a/w [#]*" Then
'stop looking
NextNumber = CLng(Mid(.Cells(6, myCol).Value, 6)) + 1
Exit Do
Else
If myCol = 1 Then
MsgBox "No a/w #'s found in row 6"
Exit Sub
End If
myCol = myCol - 1
End If
Loop

If myCol = 1 Then
MsgBox "I can't copy from the left of this column!"
Exit Sub
End If

.Columns(myCol).Copy
.Columns(myCol + 1).Insert Shift:=xlToRight
.Cells(6, myCol + 1).Value = "A/W #" & NextNumber

'keep formulas, but delete constants in rows 7:65536 of the new column
On Error Resume Next
.Range(.Cells(7, myCol + 1), .Cells(.Rows.Count, myCol + 1)) _
.Cells.SpecialCells(xlCellTypeConstants).ClearContents
On Error GoTo 0

.Cells(1, myCol + 1).Select
End With

Application.CutCopyMode = False

End Sub



Steve L. said:
=SUMPRODUCT(--(LEFT($D$5:$IV$5,5)="a/w #"),IF(ISNUMBER(D6:IV6),D6:IV6))
I can't get this one to work. If I don't get an error I get a blank cell. It
certainly looks like it should though.
Aaaanyhooo.
=SUM(D6:OFFSET(H6,0,-1))
This one does so at least I'm getting closer.
Now, back to the other code.
I didn't notice before but It's not copying the formulas. It does everything
lse beautifully though.
This is the code you posted.

Option Explicit
Sub testme01()

Dim myCol As Long
Dim NextNumber As Long

With ActiveSheet
myCol = .Cells(6, .Columns.Count).End(xlToLeft).Column

Do
If LCase(.Cells(6, myCol).Value) Like "a/w [#]*" Then
'stop looking
NextNumber = CLng(Mid(.Cells(6, myCol).Value, 6)) + 1
Exit Do
Else
If myCol = 1 Then
MsgBox "No a/w #'s found in row 6"
Exit Sub
End If
myCol = myCol - 1
End If
Loop

If myCol = 1 Then
MsgBox "I can't copy from the left of this column!"
Exit Sub
End If

.Columns(myCol + 1).Insert
.Columns(myCol).Copy
.Columns(myCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.Cells(6, myCol + 1).Value = "A/W #" & NextNumber

.Cells(1, myCol + 1).Select
End With

Application.CutCopyMode = False

End Sub

I assume your code is copying and then paste special. It should copy all of
column F's properties but it's not getting the total for each column and
the running total. The total for each column is row 81 and the running total
is row 84. This is the only thing left to figure out before I bake you a
cake.
Thanks again dave.
Click to expand...
 
Back
Top