Formatting within this macro

K

KennyD

I am new to VBA and can follow along fairly well, but don't know how to do
certain things. I have the following macro that runs like a champ, but now I
need to automatically format the SummarySheet. Specifically, I need to set
Columns A,C,E and G to a width of 2 and to have a color of Light Gray (in
Office 2010 it's White, Background 1, Darker 25%). I also need to set Rows 1
and 3 to a height of 6 and have a color of Light Gray. Then I need to change
the output font to Tahoma, 12, Bold. Finally, I have to have a cell at the
bottom of Column F that says "Totals" and then sum all the values in Column H
from H4 to the LastRow. Any help would be greatly appreciated.

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Delete the sheet "SummarySheet" if it exists
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("SummarySheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "SummarySheet"
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = "SummarySheet"

'Add headers on row 2
Newsh.Range("B2:H2").Value = Array("Merchant Name", "", "Merchant ID",
"", "Profitability", "", "Residuals")

'The links to the first sheet will start in row 4
RwNum = 3

For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 2
RwNum = RwNum + 1
'Create a link to the sheet in the B column
Newsh.Cells(RwNum, 2).Formula =
"=HYPERLINK(""#""&CELL(""address"",'" & Sh.Name & "'!A1)," _
& """" & Sh.Name & """)"
For Each myCell In Sh.Range("C3,T14,T15") '<--Change the range
ColNum = ColNum + 2
Newsh.Cells(RwNum, ColNum).Formula = "='" & Sh.Name & "'!" &
myCell.Address(False, False)
Next myCell

End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = True
End With
End Sub
 
J

Jeff

Here is one way... Just pass the worksheet name of the sheet you want to
format
like Call FormatSheet("Sheet1") When you want to format it.

Public Sub FormatWorksheet(ByVal SheetName As String)
Const Grey = &HC0C0C0
Dim ColumnArray As Variant
Dim RowArray As Variant
Dim I As Long
Dim Ws As Worksheet

Set Ws = Worksheets(SheetName)
ColumnArray = Array(1, 3, 5, 7)
RowArray = Array(1, 3)

For I = LBound(ColumnArray) To UBound(ColumnArray)
'Format Columns
With Ws
.Columns(ColumnArray(I)).ColumnWidth = 2
.Columns(ColumnArray(I)).Interior.Color = Grey
End With
Next

I = 0

For I = LBound(RowArray) To UBound(RowArray)
'Format Rows
With Ws
.Rows(RowArray(I)).RowHeight = 6
.Rows(RowArray(I)).Interior.Color = Grey
End With
Next

End Sub
 
P

Per Jessen

Hi

Try this one:

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Delete the sheet "SummarySheet" if it exists
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("SummarySheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "SummarySheet"
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = "SummarySheet"

'Add headers on row 2
Newsh.Range("B2:H2").Value = Array("Merchant Name", "", "Merchant ID",
"", "Profitability", "", "Residuals")

'The links to the first sheet will start in row 4
RwNum = 3

For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 2
RwNum = RwNum + 1
'Create a link to the sheet in the B column
Newsh.Cells(RwNum, 2).Formula =
"=HYPERLINK(""#""&CELL(""address"",'" & Sh.Name & "'!A1)," _
& """" & Sh.Name & """)"
For Each myCell In Sh.Range("C3,T14,T15") '<--Change the
range
ColNum = ColNum + 2
Newsh.Cells(RwNum, ColNum).Formula = "='" & Sh.Name & "'!" &
myCell.Address(False, False)
Next myCell

End If
Next Sh

LastRow = Newsh.Range("F" & Rows.Count).End(xlUp).Row
Newsh.Range("F" & LastRow + 1) = "Totals"
Newsh.Range("H" & LastRow + 1).Formula = "SUM(H4:H" & LastRow & ")"
Newsh.UsedRange.Columns.AutoFit
Newsh.Columns("A,C,E,G").ColumnWidth = 2
Newsh.Range("1,3").RowHeight = 6
With Newsh.Range("1,3").Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With

With Newsh.UsedRange.Font
.Name = "Tahoma"
.Size = 12
End With

Newsh.UsedRange.Font.Bold = True
Range("F16").Select
ActiveCell.FormulaR1C1 = "Totals"
Range("H16").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-12]C:R[-1]C)"
Range("H17").Select

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = True
End With
End Sub

Regards,
Per
 
R

Ryan H

You code have used the Macro Recorder for something like this. I like to use
it for simple macros which helps you identify certain objects and properties.
It also will help you learn a few things about VBA. I added all the sheet
formatting code at the end of your code. Hope this helps! If so, let me
know, click "YES" below.

Sub Summary_All_Worksheets_With_Formulas()

Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook
Dim LastRow As Long

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Delete the sheet "SummarySheet" if it exists
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("SummarySheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "SummarySheet"
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = "SummarySheet"

'Add headers on row 2
Newsh.Range("B2:H2").Value = Array("Merchant Name", "", "Merchant ID", _
"", "Profitability", "",
"Residuals")

'The links to the first sheet will start in row 4
RwNum = 3

For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 2
RwNum = RwNum + 1
'Create a link to the sheet in the B column
Newsh.Cells(RwNum, 2).Formula =
"=HYPERLINK(""#""&CELL(""address"",'" & Sh.Name & "'!A1)," _
& """" & Sh.Name & """)"
For Each myCell In Sh.Range("C3,T14,T15") '<--Change the range
ColNum = ColNum + 2
Newsh.Cells(RwNum, ColNum).Formula = "='" & Sh.Name & "'!" &
myCell.Address(False, False)
Next myCell

End If
Next Sh

With Newsh
.UsedRange.Columns.AutoFit

'Columns A,C,E and G to a width of 2 and to have a color of Light
Gray (in
'Office 2010 it's White, Background 1, Darker 25%)
With .Range("A:A,C:C,E:E,G:G")
.ColumnWidth = 2
.Interior.ColorIndex = 15
End With

' I also need to set Rows 1 and 3 to a height of 6 and have a color
of Light Gray.
With .Range("1:1", "3:3")
.RowHeight = 6
.Interior.ColorIndex = 15
End With

' sum column H
LastRow = .Cells(Rows.Count, "F").End(xlUp).Row
.Cells(LastRow + 1, "F").Value = "Totals"
.Cells(LastRow + 1, "H").Formula = "=SUM(H4:H" & LastRow & ")"
End With

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = True
End With
End Sub
 
K

KennyD

Thanks Jeff. That worked like a champ. But how do I add the word "Totals"
in Column F one row after the last row (because the last row will be
changing), and then sum the values in Column H? Any thoughts on that?
 
R

Ryan H

Check my code out in the previous post! Hope this helps! If so, let me
know, click "YES" below.
 
J

Jeff

Public Sub FormatWorksheet(ByVal SheetName As String)
Const Grey = &HC0C0C0
Dim LastRow As Long
Dim ColumnArray As Variant
Dim RowArray As Variant
Dim I As Long
Dim Ws As Worksheet

Set Ws = Worksheets(SheetName)
ColumnArray = Array(1, 3, 5, 7)
RowArray = Array(1, 3)
LastRow = Ws.Cells(Rows.Count, 6).End(xlUp).Row + 1


For I = LBound(ColumnArray) To UBound(ColumnArray)
'Format Columns
With Ws
.Columns(ColumnArray(I)).ColumnWidth = 2
.Columns(ColumnArray(I)).Interior.Color = Grey
End With
Next

I = 0

For I = LBound(RowArray) To UBound(RowArray)
'Format Rows
With Ws
.Rows(RowArray(I)).RowHeight = 6
.Rows(RowArray(I)).Interior.Color = Grey
End With
Next

Ws.Range("F" & LastRow).Value = "Totals:"
End Sub
 
J

Jeff

Add this & WorksheetFunction.Sum(Range("H:H"))
After this Ws.Range("F" & LastRow).Value = "Totals:"
to add Column "H"
 
D

Dave Peterson

Check your other post, too.
I am new to VBA and can follow along fairly well, but don't know how to do
certain things. I have the following macro that runs like a champ, but now I
need to automatically format the SummarySheet. Specifically, I need to set
Columns A,C,E and G to a width of 2 and to have a color of Light Gray (in
Office 2010 it's White, Background 1, Darker 25%). I also need to set Rows 1
and 3 to a height of 6 and have a color of Light Gray. Then I need to change
the output font to Tahoma, 12, Bold. Finally, I have to have a cell at the
bottom of Column F that says "Totals" and then sum all the values in Column H
from H4 to the LastRow. Any help would be greatly appreciated.

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Delete the sheet "SummarySheet" if it exists
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("SummarySheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "SummarySheet"
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = "SummarySheet"

'Add headers on row 2
Newsh.Range("B2:H2").Value = Array("Merchant Name", "", "Merchant ID",
"", "Profitability", "", "Residuals")

'The links to the first sheet will start in row 4
RwNum = 3

For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 2
RwNum = RwNum + 1
'Create a link to the sheet in the B column
Newsh.Cells(RwNum, 2).Formula =
"=HYPERLINK(""#""&CELL(""address"",'" & Sh.Name & "'!A1)," _
& """" & Sh.Name & """)"
For Each myCell In Sh.Range("C3,T14,T15") '<--Change the range
ColNum = ColNum + 2
Newsh.Cells(RwNum, ColNum).Formula = "='" & Sh.Name & "'!" &
myCell.Address(False, False)
Next myCell

End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = True
End With
End Sub
Click to expand...
 
K

KennyD

Per,

Thank you. This worked exactly like I wanted. Awesome. The only thing
that I changed was that it now reads:
Newsh.Range("F" & (LastRow + 2)) = "Totals"

Then I threw in a little formatting and what not.
--
Nothing in life is ever easy - just get used to that fact.


Per Jessen said:
Hi

Try this one:

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Delete the sheet "SummarySheet" if it exists
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("SummarySheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "SummarySheet"
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = "SummarySheet"

'Add headers on row 2
Newsh.Range("B2:H2").Value = Array("Merchant Name", "", "Merchant ID",
"", "Profitability", "", "Residuals")

'The links to the first sheet will start in row 4
RwNum = 3

For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 2
RwNum = RwNum + 1
'Create a link to the sheet in the B column
Newsh.Cells(RwNum, 2).Formula =
"=HYPERLINK(""#""&CELL(""address"",'" & Sh.Name & "'!A1)," _
& """" & Sh.Name & """)"
For Each myCell In Sh.Range("C3,T14,T15") '<--Change the
range
ColNum = ColNum + 2
Newsh.Cells(RwNum, ColNum).Formula = "='" & Sh.Name & "'!" &
myCell.Address(False, False)
Next myCell

End If
Next Sh

LastRow = Newsh.Range("F" & Rows.Count).End(xlUp).Row
Newsh.Range("F" & LastRow + 1) = "Totals"
Newsh.Range("H" & LastRow + 1).Formula = "SUM(H4:H" & LastRow & ")"
Newsh.UsedRange.Columns.AutoFit
Newsh.Columns("A,C,E,G").ColumnWidth = 2
Newsh.Range("1,3").RowHeight = 6
With Newsh.Range("1,3").Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With

With Newsh.UsedRange.Font
.Name = "Tahoma"
.Size = 12
End With

Newsh.UsedRange.Font.Bold = True
Range("F16").Select
ActiveCell.FormulaR1C1 = "Totals"
Range("H16").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-12]C:R[-1]C)"
Range("H17").Select

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = True
End With
End Sub

Regards,
Per

KennyD said:
I am new to VBA and can follow along fairly well, but don't know how to do
certain things. I have the following macro that runs like a champ, but
now I
need to automatically format the SummarySheet. Specifically, I need to
set
Columns A,C,E and G to a width of 2 and to have a color of Light Gray (in
Office 2010 it's White, Background 1, Darker 25%). I also need to set
Rows 1
and 3 to a height of 6 and have a color of Light Gray. Then I need to
change
the output font to Tahoma, 12, Bold. Finally, I have to have a cell at
the
bottom of Column F that says "Totals" and then sum all the values in
Column H
from H4 to the LastRow. Any help would be greatly appreciated.

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Delete the sheet "SummarySheet" if it exists
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("SummarySheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "SummarySheet"
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = "SummarySheet"

'Add headers on row 2
Newsh.Range("B2:H2").Value = Array("Merchant Name", "", "Merchant ID",
"", "Profitability", "", "Residuals")

'The links to the first sheet will start in row 4
RwNum = 3

For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 2
RwNum = RwNum + 1
'Create a link to the sheet in the B column
Newsh.Cells(RwNum, 2).Formula =
"=HYPERLINK(""#""&CELL(""address"",'" & Sh.Name & "'!A1)," _
& """" & Sh.Name & """)"
For Each myCell In Sh.Range("C3,T14,T15") '<--Change the
range
ColNum = ColNum + 2
Newsh.Cells(RwNum, ColNum).Formula = "='" & Sh.Name & "'!"
&
myCell.Address(False, False)
Next myCell

End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = True
End With
End Sub
Click to expand...

.
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Creating a summary sheet 9
Summary All Worksheets With links 7
Error 1004 'Range' when using French Regional options but not Engl 6
Summary All Worksheets With Formulas - Ron De Bruin modified 1
How to change this Ron deBruin Macro 10
Summary Sheet from range specified in a worksheet 4
Modify RDB code with find and offset 6
Create macro button 1

Top