Macro help

J

Joe

I am relatively new to recording macros with excel 2003. The issue I have is
that I have the macro recorded and working properly. This macro will be used
frequently in the same worksheet. It is basic formatting, text and formulas.
What I would like to have happen is that when I run the maro it wll drop down
vertically within the same columns from the range of cells above. Basically
so the macro will cascade down vertically. Does this make sense. Can anyone
help me. Thanks.
 
O

Otto Moehrbach

Do you mean that you want the macro to run repeatedly with each cell in the
column, in turn, being the active cell?. If not, try to explain it again,
and, as Don said, include your current code in your post. HTH Otto
 
J

Joe

Here is the VBA code. What I would like to have happen is everytime I run
this macro is to have it format the cells directly underneath the previously
formatted cells, So it just keeps going down the spreadsheet. For example
this code will format cells in the range of G1 to M 20, the next time I run
the macro it should format cells G21 to M40. Does this make sense?

Sub NEWSHT()
'
' NEWSHT Macro
' Macro recorded 5/7/2006 by
'

'
Rows("1:1").Select
Selection.RowHeight = 20
Range("G1").Select
ActiveCell.FormulaR1C1 = "Remarks"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Proposed" & Chr(10) & "Elevation"
With ActiveCell.Characters(Start:=1, Length:=18).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("I1").Select
ActiveCell.FormulaR1C1 = "Exisiting" & Chr(10) & "Elevation"
With ActiveCell.Characters(Start:=1, Length:=19).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("J1").Select
ActiveCell.FormulaR1C1 = "Diff."
Range("K1").Select
ActiveCell.FormulaR1C1 = "Fill"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Cut"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Description"
Columns("M:M").Select
Selection.ColumnWidth = 20
Columns("G:G").Select
Selection.ColumnWidth = 20
Columns("H:H").Select
Selection.ColumnWidth = 12
Columns("I:I").Select
Selection.ColumnWidth = 12
ActiveWindow.SmallScroll Down:=-3
Range("G1:M20").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("G1:M1").Select
ActiveWindow.ScrollColumn = 3
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("J22").Select
ActiveWindow.SmallScroll Down:=-12
Rows("1:1").EntireRow.AutoFit
Range("G1:M1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range("G1").Select
End Sub
 
D

Don Guillett

try this instead of your code. NO selections

Sub trythisinstead()
nr = Range("a1").SpecialCells(xlLastCell).Row
'MsgBox nr
Rows(nr).RowHeight = 20
Cells(nr, "g") = "Remarks"
Cells(nr, "H") = "Proposed" & Chr(10) & "Elevation"
Cells(nr, "I") = "Exisiting" & Chr(10) & "Elevation"
Cells(nr, "J") = "Diff."
Cells(nr, "K") = "Fill"
Cells(nr, "L") = "Cut"
Cells(nr, "M") = "Description"
Columns("g").ColumnWidth = 20
Columns("M").ColumnWidth = 20
Columns("H:i").ColumnWidth = 12

Range(Cells(nr, "g"), Cells(nr + 19, "m")) _
..BorderAround LineStyle:=xlContinuous, Weight:=xlThick

With Range(Cells(nr, "g"), Cells(nr, "m"))
.BorderAround LineStyle:=xlContinuous, Weight:=xlThick
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With

Rows(nr).EntireRow.AutoFit

End Sub
 
O

Otto Moehrbach

Don
Your code puts a border around the entire range G1:M20 as well as G1:M1,
but no borders around each cell in the range. The OP's code puts borders
around each cell so I assume that's what he wanted. Is there a code that
puts borders around each cell in a range without using the laborious:
Borders(xlEdgeLeft)
Borders(xlEdgeRight)
Borders(xlEdgeTop)
Borders(xlEdgeBottom)
and all the attending lines of code that goes with each of these lines of
code (such as what you get when you record a macro and specify each edge)?
Thanks for your help. Otto
 
O

Otto Moehrbach

Don
I used .Borders as you said (see code below) and got an "Invalid use of
property" error on the word ".Borders". Thanks for your help. Otto
Sub TestBorders()
Range("G1:M20") _
.Borders LineStyle:=xlContinuous, Weight:=xlThick
End Sub
 
D

Don Guillett

.Borders LineStyle:=xlContinuous, Weight:=xlThick
you forgot a dot
..Borders.LineStyle:=xlContinuous, Weight:=xlThick
 
O

Otto Moehrbach

Don
That doesn't work either. I get an error as soon as I type the dot and
leave that line. When I run the macro I get a Syntax error. Without the
dot I get an "Invalid use of property" error. The dot code I used is:
Sub TestBorders()
Range("G1:M20") _
.Borders.LineStyle:=xlContinuous, Weight:=xlThick
End Sub

The same code without the dot is:
Sub TestBorders()
Range("G1:M20") _
.Borders LineStyle:=xlContinuous, Weight:=xlThick
End Sub
I appreciate the time you are spending on this. Thanks. Otto
 
J

Joe

Don,
Thanks for the help, but you code has a syntax error in it. Anyway, I just
want to know how to make it format a range of cells but also to have it drop
directly below the last range of cells, every time I run it. Thanks.
 
D

Don Guillett

I just tested

this xl2002 all upgrades
..Borders.LineStyle = xlContinuous
without the :

If THICK desired,uncomment the weight line
With Range(Cells(nr, "g"), Cells(nr + 19, "m"))
..Borders.LineStyle = xlContinuous
'.Borders.Weight = xlThick
..BorderAround LineStyle:=xlContinuous, Weight:=xlThick

End With
 
D

Don Guillett

I just re-tested this with the change to do the borders within the outside
border. It works just fine in xl2002 and I also tested in xl97. Please
explain or send your workbook with a detailed explanation of what your
problem is with "syntax error"??

Sub trythisinstead()
nr = Range("a1").SpecialCells(xlLastCell).Row
'MsgBox nr
Rows(nr).RowHeight = 20
Cells(nr, "g") = "Remarks"
Cells(nr, "H") = "Proposed" & Chr(10) & "Elevation"
Cells(nr, "I") = "Exisiting" & Chr(10) & "Elevation"
Cells(nr, "J") = "Diff."
Cells(nr, "K") = "Fill"
Cells(nr, "L") = "Cut"
Cells(nr, "M") = "Description"
Columns("g").ColumnWidth = 20
Columns("M").ColumnWidth = 20
Columns("H:i").ColumnWidth = 12

With Range(Cells(nr, "g"), Cells(nr + 19, "m"))
..Borders.LineStyle = xlContinuous 'added
'.Borders.Weight = xlThick 'added
..BorderAround LineStyle:=xlContinuous, Weight:=xlThick
End With

With Range(Cells(nr, "g"), Cells(nr, "m"))
.BorderAround LineStyle:=xlContinuous, Weight:=xlThick
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
Rows(nr).EntireRow.AutoFit
End Sub
 
O

Otto Moehrbach

Don
I too have 2002. Your code without the ":" as you explained worked
perfectly. Thanks for hanging in there with me. Your help is much
appreciated. Otto
 
O

Otto Moehrbach

Joe
I'll work up something for you today. Otto
Joe said:
Don,
Thanks for the help, but you code has a syntax error in it. Anyway, I just
want to know how to make it format a range of cells but also to have it
drop
directly below the last range of cells, every time I run it. Thanks.
Click to expand...
 
O

Otto Moehrbach

Joe
Looking at your code, I think what you want, as far as borders are
concerned, is a thick border around the whole range and thin borders around
each cell within the range. Is that right?
Also, your code enters headers in the first row of the range. Do you
want these headers in the first row of EACH range (every time you execute
the macro) or just in the first row of the first range, i.e., in row 1 only?
Get back to me on this. Otto
 
O

Otto Moehrbach

Joe
Rather than have one long macro I broke it up into 3 macros and
declarations. Paste all of this into a standard module. Watch out for line
wrapping.
I assumed that you want the header row in only row 1 and not repeated
every time you run the macro, so I wrote the macros that way. If this is
not right, let me know and I'll massage it as needed for you. When you want
to run this, run only macro NEWSHT2. The other two macros run
automatically.
If you have errors it will be because of line wrapping in this message.
If you wish, send me an email with a valid email address for you and I'll
send you the small file I used for this with the code included. My email
address is [email protected]. Remove the "nop" from this address. HTH
Otto
Option Explicit
Dim RngG As Range
Dim i As Range
Dim FirstCell As Range
Dim LastCell As Range
Dim TheRng As Range

Sub NEWSHT2()
Set RngG = Range("G1:G65536")
If [G1].Value <> "Remarks" Then
Set FirstCell = Range("G1")
Call IntitialSetup
Else
For Each i In RngG
If i.Borders(xlEdgeLeft).LineStyle = xlNone Then Exit For
Next i
Set FirstCell = i
End If
Set LastCell = Range(FirstCell, FirstCell.Offset(20, 6))
Set TheRng = Range(FirstCell, LastCell)
Call PutBorders
End Sub

Sub IntitialSetup()
Rows("1:1").RowHeight = 20
Range("G1").Value = "Remarks"
Range("H1").Value = "Proposed" & Chr(10) & "Elevation"
Range("I1").Value = "Exisiting" & Chr(10) & "Elevation"
With Range("H1:I1").Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
End With
Range("J1").Value = "Diff."
Range("K1").Value = "Fill"
Range("L1").Value = "Cut"
Range("M1").Value = "Description"
Rows("1:1").EntireRow.AutoFit
Range("M:M,G:G").ColumnWidth = 20
Columns("H:I").ColumnWidth = 12
With Range("G1").Resize(, 7)
.BorderAround LineStyle:=xlContinuous, Weight:=xlThick
End With
End Sub

Sub PutBorders()
With TheRng
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.BorderAround LineStyle:=xlContinuous, Weight:=xlThick
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
Range("G1").Select
End Sub
 
J

Joe

Don and Otto, Thanks for your help. I will try the new macros today.

Otto,
Sorry I took so long to reply, I would like the Text from row 1 to also
drop down with the rest of the formatting. I mean I would like the headers to
be at the top row of everyrange. Thanks again.
 
O

Otto Moehrbach

Joe
Here is the code to do it all as well as repeat the header row in the
top row of every range. HTH Otto
Option Explicit
Dim RngG As Range
Dim i As Range
Dim FirstCell As Range
Dim LastCell As Range
Dim TheRng As Range

Sub NEWSHT2()
Set RngG = Range("G1:G65536")
If [G1].Value <> "Remarks" Then
Set FirstCell = Range("G1")
Else
For Each i In RngG
If i.Borders(xlEdgeLeft).LineStyle = xlNone Then Exit For
Next i
Set FirstCell = i
End If
Set LastCell = Range(FirstCell, FirstCell.Offset(20, 6))
Set TheRng = Range(FirstCell, LastCell)
Call PutBorders
End Sub

Sub IntitialSetup()
TheRng(1).EntireRow.RowHeight = 20
TheRng(1).Value = "Remarks"
TheRng(2).Value = "Proposed" & Chr(10) & "Elevation"
TheRng(3).Value = "Existing" & Chr(10) & "Elevation"
With TheRng(2).Resize(, 2).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
End With
TheRng(4).Value = "Diff."
TheRng(5).Value = "Fill"
TheRng(6).Value = "Cut"
TheRng(7).Value = "Description"
TheRng(1).EntireRow.AutoFit
Range("M:M,G:G").ColumnWidth = 20
Columns("H:I").ColumnWidth = 12
End Sub

Sub PutBorders()
Call IntitialSetup
With TheRng
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.BorderAround LineStyle:=xlContinuous, Weight:=xlThick
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
With TheRng(1).Resize(, 7)
.BorderAround LineStyle:=xlContinuous, Weight:=xlThick
End With
TheRng(1).Select
End Sub
 
Top