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
--
Nothing in life is ever easy - just get used to that fact.

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


"KennyD" wrote:

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
--
Nothing in life is ever easy - just get used to that fact.

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" skrev i meddelelsen
...
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
--
Nothing in life is ever easy - just get used to that fact.

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
--
Cheers,
Ryan


"KennyD" wrote:

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
--
Nothing in life is ever easy - just get used to that fact.

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?
--
Nothing in life is ever easy - just get used to that fact.


"Jeff" wrote:

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


"KennyD" wrote:

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
--
Nothing in life is ever easy - just get used to that fact.

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


"KennyD" wrote:

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?
--
Nothing in life is ever easy - just get used to that fact.


"Jeff" wrote:

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


"KennyD" wrote:

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
--
Nothing in life is ever easy - just get used to that fact.

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

"Jeff" wrote:

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


"KennyD" wrote:

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
--
Nothing in life is ever easy - just get used to that fact.

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

"KennyD" wrote:

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?
--
Nothing in life is ever easy - just get used to that fact.


"Jeff" wrote:

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


"KennyD" wrote:

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
--
Nothing in life is ever easy - just get used to that fact.

It keeps giving me an Unqualified error at the very last section.

' 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

--
Nothing in life is ever easy - just get used to that fact.


"Ryan H" wrote:

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
--
Cheers,
Ryan


"KennyD" wrote:

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
--
Nothing in life is ever easy - just get used to that fact.

Check your other post, too.

KennyD wrote:

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
--
Nothing in life is ever easy - just get used to that fact.

--

Dave Peterson

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" wrote:

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" skrev i meddelelsen
...
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
--
Nothing in life is ever easy - just get used to that fact.

.

I know - I had it in there twice. The first was under the General Questions,
but then realized that I should have posted it under the Programming section.
If you have a minute, can you look at the following post?

http://www.microsoft.com/office/comm...1e7&sloc=en-us

This post was based on a macro that you had written awhile ago. Thanks.
--
Nothing in life is ever easy - just get used to that fact.


"Dave Peterson" wrote:

Check your other post, too.

KennyD wrote:

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
--
Nothing in life is ever easy - just get used to that fact.

--

Dave Peterson
.

Ron responded with to that post.

KennyD wrote:

I know - I had it in there twice. The first was under the General Questions,
but then realized that I should have posted it under the Programming section.
If you have a minute, can you look at the following post?

http://www.microsoft.com/office/comm...1e7&sloc=en-us

This post was based on a macro that you had written awhile ago. Thanks.
--
Nothing in life is ever easy - just get used to that fact.

"Dave Peterson" wrote:

Check your other post, too.

KennyD wrote:

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
--
Nothing in life is ever easy - just get used to that fact.

--

Dave Peterson
.


--

Dave Peterson