Macro help

[Don Guillett]

I'm still curious as to what's wrong with my shorter code?

--
Don Guillett
SalesAid Software
(e-mail address removed)

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

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.

 

[Joe]

Otto,
Your the man! Works great. Just what I was looking for.

Don,
I will also give yours a try and let you know. Thanks, Don & Otto so much
for all of your help. I have a few more questions, but first I will edit the
VBA file so it is structure exactly how I want, and add my formulas. We will
see how it turns out. This actually a grade sheet a am developing for my land
surveying company. I think it will be great. Thank again. P.S. Are you guys
good with formulas also? My next question will be a formula one and since you
both kinda know what i am developing I was hoping you both can help with the
formulas as well. I will post my new question soon.

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

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.

 

[Joe]

Otto,
I have tried to edit the code you wrote for me but without any luck. What I
need is to add Offset in the header in column H and bump the rest of the
headers to the right one column. Here is the code I edited, can u help me?
Also let me know if you would what i did wrong. Thanks

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 <> "Description" 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 = "Description"
TheRng(2).Value = "Offset"
TheRng(3).Value = "Proposed" & Chr(10) & "Elevation"
TheRng(4).Value = "Stake" & Chr(10) & "Elevation"
With TheRng(2).Resize(, 2).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
End With
TheRng(5).Value = "Diff."
TheRng(6).Value = "(F)" & Chr(10) & "Fill"
TheRng(7).Value = "(C)" & Chr(10) & "Cut"
TheRng(8).Value = "Remarks"
TheRng(1).EntireRow.AutoFit
Range("N:N,G:G").ColumnWidth = 20
Columns("I:J").ColumnWidth = 12
Column("H:H").ColumnWidth = 10
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

 

[Don Guillett]

What was wrong with mine?

--
Don Guillett
SalesAid Software
(e-mail address removed)

Otto,
I have tried to edit the code you wrote for me but without any luck. What
I
need is to add Offset in the header in column H and bump the rest of the
headers to the right one column. Here is the code I edited, can u help me?
Also let me know if you would what i did wrong. Thanks

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 <> "Description" 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 = "Description"
TheRng(2).Value = "Offset"
TheRng(3).Value = "Proposed" & Chr(10) & "Elevation"
TheRng(4).Value = "Stake" & Chr(10) & "Elevation"
With TheRng(2).Resize(, 2).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
End With
TheRng(5).Value = "Diff."
TheRng(6).Value = "(F)" & Chr(10) & "Fill"
TheRng(7).Value = "(C)" & Chr(10) & "Cut"
TheRng(8).Value = "Remarks"
TheRng(1).EntireRow.AutoFit
Range("N:N,G:G").ColumnWidth = 20
Columns("I:J").ColumnWidth = 12
Column("H:H").ColumnWidth = 10
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

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.

 

[Joe]

Don,
I keep trying yours but can not get it to work. This is what I tried, I
thought I had edited it correctly but cannot get it.

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

 

[Joe]

Don,
I tried yours but can't get it to work.

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

What was wrong with mine?

--
Don Guillett
SalesAid Software
(e-mail address removed)

Otto,
I have tried to edit the code you wrote for me but without any luck. What
I
need is to add Offset in the header in column H and bump the rest of the
headers to the right one column. Here is the code I edited, can u help me?
Also let me know if you would what i did wrong. Thanks

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 <> "Description" 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 = "Description"
TheRng(2).Value = "Offset"
TheRng(3).Value = "Proposed" & Chr(10) & "Elevation"
TheRng(4).Value = "Stake" & Chr(10) & "Elevation"
With TheRng(2).Resize(, 2).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
End With
TheRng(5).Value = "Diff."
TheRng(6).Value = "(F)" & Chr(10) & "Fill"
TheRng(7).Value = "(C)" & Chr(10) & "Cut"
TheRng(8).Value = "Remarks"
TheRng(1).EntireRow.AutoFit
Range("N:N,G:G").ColumnWidth = 20
Columns("I:J").ColumnWidth = 12
Column("H:H").ColumnWidth = 10
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

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.

 

[Otto Moehrbach]

Joe

The last line of the "InitialSetup" macro has "Column". That
should be "Columns".

The code sets the "TheRng" range in the "NEWSHT2" macro as having 7 columns.
That's the way I had it and the way you still have it. But you now want to
add an 8th column. So you need to change the "Offset(20,6)" to
"Offset(20,7)".

The corrected code is:

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 <> "Description" 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, 7))

Set TheRng = Range(FirstCell, LastCell)

Call PutBorders

End Sub



Sub IntitialSetup()

TheRng(1).EntireRow.RowHeight = 20

TheRng(1).Value = "Description"

TheRng(2).Value = "Offset"

TheRng(3).Value = "Proposed" & Chr(10) & "Elevation"

TheRng(4).Value = "Stake" & Chr(10) & "Elevation"

With TheRng(2).Resize(, 2).Font

.Name = "Arial"

.FontStyle = "Regular"

.Size = 10

End With

TheRng(5).Value = "Diff."

TheRng(6).Value = "(F)" & Chr(10) & "Fill"

TheRng(7).Value = "(C)" & Chr(10) & "Cut"

TheRng(8).Value = "Remarks"

TheRng(1).EntireRow.AutoFit

Range("N:N,G:G").ColumnWidth = 20

Columns("I:J").ColumnWidth = 12

Columns("H:H").ColumnWidth = 10

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(, 8)

.BorderAround LineStyle:=xlContinuous, Weight:=xlThick

End With

TheRng(1).Select

End Sub



Otto

Otto,
I have tried to edit the code you wrote for me but without any luck. What
I
need is to add Offset in the header in column H and bump the rest of the
headers to the right one column. Here is the code I edited, can u help me?
Also let me know if you would what i did wrong. Thanks

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 <> "Description" 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 = "Description"
TheRng(2).Value = "Offset"
TheRng(3).Value = "Proposed" & Chr(10) & "Elevation"
TheRng(4).Value = "Stake" & Chr(10) & "Elevation"
With TheRng(2).Resize(, 2).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
End With
TheRng(5).Value = "Diff."
TheRng(6).Value = "(F)" & Chr(10) & "Fill"
TheRng(7).Value = "(C)" & Chr(10) & "Cut"
TheRng(8).Value = "Remarks"
TheRng(1).EntireRow.AutoFit
Range("N:N,G:G").ColumnWidth = 20
Columns("I:J").ColumnWidth = 12
Column("H:H").ColumnWidth = 10
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

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.

 

[Don Guillett]

Joe, 2 things

1. Editing was not needed. Why did you insert an extra dot ( . ) in the
with statement?

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

2. You need to make sure that you start with a blank page. Use ctrl +home
and the cursor needs to wind up in cell a1 for nr= to be accurate. If
not, delete the extra rows & delete the extra columns, save. Then fire the
macro. It DOES work!
Feel free to send a workbook to my personal email address. I don't have
yours.

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
.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