Summary All Worksheets With links

al007 · 02-13-2006, 04:50 PM

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

Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add

On Error Resume Next
Newsh.Name = "Summary-Sheet"
If Err.Number > 0 Then
MsgBox "The Summary sheet already exist in this workbook."
With Application
.DisplayAlerts = False
Newsh.Delete
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
End If

RwNum = 1
'The links to the first sheet will start in row 2

For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 1
RwNum = RwNum + 1

Newsh.Cells(RwNum, 1).Value = Sh.Name
'Copy the sheet name in the A column

For Each myCell In Sh.Range("A1,D5:E5,Z10") '
<----Change the range
ColNum = ColNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

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

Could Ron or another guru tell me how I can amend the above code as
follows:

(1) Allow me to select the range I want with a message box - where
should i put the code below??

myRange = Application.InputBox( _
Prompt:="Select cell for Standard data.", Type:=8)

(2) Allow me to select the sheets I want instead of all visible
sheets??

(For Each Sh In ActiveWindow.SelectedSheets)

thxs

Ron de Bruin · 02-13-2006, 05:30 PM

Hi al007

Do you want to copy data from a few sheets or create links to the cells???
Is the range continuous ?

--
Regards Ron de Bruin
http://www.rondebruin.nl

"al007" <transferxxx@gmail.com> wrote in message news:1139863574.828427.19050@f14g2000cwb.googlegroups.com...
> 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
>
> Set Basebook = ThisWorkbook
> Set Newsh = Basebook.Worksheets.Add
>
> On Error Resume Next
> Newsh.Name = "Summary-Sheet"
> If Err.Number > 0 Then
> MsgBox "The Summary sheet already exist in this workbook."
> With Application
> .DisplayAlerts = False
> Newsh.Delete
> .DisplayAlerts = True
> .Calculation = xlCalculationAutomatic
> .ScreenUpdating = True
> End With
> Exit Sub
> End If
>
> RwNum = 1
> 'The links to the first sheet will start in row 2
>
> For Each Sh In Basebook.Worksheets
> If Sh.Name <> Newsh.Name And Sh.Visible Then
> ColNum = 1
> RwNum = RwNum + 1
>
> Newsh.Cells(RwNum, 1).Value = Sh.Name
> 'Copy the sheet name in the A column
>
> For Each myCell In Sh.Range("A1,D5:E5,Z10") '
> <----Change the range
> ColNum = ColNum + 1
> Newsh.Cells(RwNum, ColNum).Formula = _
> "='" & Sh.Name & "'!" & myCell.Address(False, False)
> Next myCell
> End If
> Next Sh
>
> Newsh.UsedRange.Columns.AutoFit
>
> With Application
> .Calculation = xlCalculationAutomatic
> .ScreenUpdating = True
> End With
> End Sub
>
> Could Ron or another guru tell me how I can amend the above code as
> follows:
>
> (1) Allow me to select the range I want with a message box - where
> should i put the code below??
>
> myRange = Application.InputBox( _
> Prompt:="Select cell for Standard data.", Type:=8)
>
> (2) Allow me to select the sheets I want instead of all visible
> sheets??
>
> (For Each Sh In ActiveWindow.SelectedSheets)
>
> thxs
>

al007 · 02-13-2006, 10:20 PM

I want to create links to the cells & range can be continuous or non
continuous.
& as per previous post
(3) Allow me to put the range to be copied in an existing sheet
(instead of a new sheet) with a messge box to enter the first cell
where it would start - as I need to run macro for several times on
different range

thxs

Ron de Bruin · 02-14-2006, 01:15 AM

Hi al007

I look at it after work

--
Regards Ron de Bruin
http://www.rondebruin.nl

"al007" <transferxxx@gmail.com> wrote in message news:1139883450.284557.67510@g44g2000cwa.googlegroups.com...
>I want to create links to the cells & range can be continuous or non
> continuous.
> & as per previous post
> (3) Allow me to put the range to be copied in an existing sheet
> (instead of a new sheet) with a messge box to enter the first cell
> where it would start - as I need to run macro for several times on
> different range
>
> thxs
>

Ron de Bruin · 02-14-2006, 05:50 PM

Hi

I don not like the way you want to do this with selecting more then one sheet but OK

Note: Copy also the function in the module

It will use this sheet
Set Destsh = Sheets("Summary-Sheet")

Select the cells you want before you run the macro
Then select the sheets you want and run the macro
Every time you run the macro it will add the links below the last line

Note : not more then 256 cells

Sub Summary_All_Worksheets_With_Formulas_Test()
Dim sh As Worksheet
Dim Destsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook
Dim rngaddr As String

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

Set Basebook = ThisWorkbook
Set Destsh = Sheets("Summary-Sheet")

rngaddr = Selection.Address(False, False)

RwNum = LastRow(Destsh) + 1
'The links to the first sheet will start in the first empty row

For Each sh In ActiveWindow.SelectedSheets
ColNum = 1
RwNum = RwNum + 1

Destsh.Cells(RwNum, 1).Value = sh.Name
'Copy the sheet name in the A column

For Each myCell In sh.Range(rngaddr)
ColNum = ColNum + 1
Destsh.Cells(RwNum, ColNum).Formula = _
"='" & sh.Name & "'!" & myCell.Address(False, False)
Next myCell
Next sh

Destsh.UsedRange.Columns.AutoFit

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

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

--
Regards Ron de Bruin
http://www.rondebruin.nl

"al007" <transferxxx@gmail.com> wrote in message news:1139883450.284557.67510@g44g2000cwa.googlegroups.com...
>I want to create links to the cells & range can be continuous or non
> continuous.
> & as per previous post
> (3) Allow me to put the range to be copied in an existing sheet
> (instead of a new sheet) with a messge box to enter the first cell
> where it would start - as I need to run macro for several times on
> different range
>
> thxs
>

al007 · 02-14-2006, 06:30 PM

Hi Ron,
Thxs for your prompt reply - but I did not expect all selected row of a
sheet to be summarised in only 1 row in the summary sheet.
I wanted it in individual row
e,if my selected sheets are sheet1 & sheet2 & range being A1:C3
i would expect data as follows:
=Sheet1!A1 =Sheet1!B1 =Sheet1!C1
=Sheet1!A2 =Sheet1!B2 =Sheet1!C2
=Sheet1!A3 =Sheet1!B3 =Sheet1!C3
=Sheet2!A1 =Sheet2!B1 =Sheet2!C1
=Sheet2!A2 =Sheet2!B2 =Sheet2!C2
=Sheet2!A3 =Sheet2!B3 =Sheet2!C3

can you help pls

thxs

Ron de Bruin wrote:
> Hi
>
> I don not like the way you want to do this with selecting more then one sheet but OK
>
> Note: Copy also the function in the module
>
> It will use this sheet
> Set Destsh = Sheets("Summary-Sheet")
>
> Select the cells you want before you run the macro
> Then select the sheets you want and run the macro
> Every time you run the macro it will add the links below the last line
>
> Note : not more then 256 cells
>
> Sub Summary_All_Worksheets_With_Formulas_Test()
> Dim sh As Worksheet
> Dim Destsh As Worksheet
> Dim myCell As Range
> Dim ColNum As Integer
> Dim RwNum As Long
> Dim Basebook As Workbook
> Dim rngaddr As String
>
> With Application
> .Calculation = xlCalculationManual
> .ScreenUpdating = False
> End With
>
> Set Basebook = ThisWorkbook
> Set Destsh = Sheets("Summary-Sheet")
>
> rngaddr = Selection.Address(False, False)
>
>
> RwNum = LastRow(Destsh) + 1
> 'The links to the first sheet will start in the first empty row
>
> For Each sh In ActiveWindow.SelectedSheets
> ColNum = 1
> RwNum = RwNum + 1
>
> Destsh.Cells(RwNum, 1).Value = sh.Name
> 'Copy the sheet name in the A column
>
> For Each myCell In sh.Range(rngaddr)
> ColNum = ColNum + 1
> Destsh.Cells(RwNum, ColNum).Formula = _
> "='" & sh.Name & "'!" & myCell.Address(False, False)
> Next myCell
> Next sh
>
> Destsh.UsedRange.Columns.AutoFit
>
> With Application
> .Calculation = xlCalculationAutomatic
> .ScreenUpdating = True
> End With
> End Sub
>
>
> Function LastRow(sh As Worksheet)
> On Error Resume Next
> LastRow = sh.Cells.Find(What:="*", _
> After:=sh.Range("A1"), _
> Lookat:=xlPart, _
> LookIn:=xlFormulas, _
> SearchOrder:=xlByRows, _
> SearchDirection:=xlPrevious, _
> MatchCase:=False).Row
> On Error GoTo 0
> End Function
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
> "al007" <transferxxx@gmail.com> wrote in message news:1139883450.284557.67510@g44g2000cwa.googlegroups.com...
> >I want to create links to the cells & range can be continuous or non
> > continuous.
> > & as per previous post
> > (3) Allow me to put the range to be copied in an existing sheet
> > (instead of a new sheet) with a messge box to enter the first cell
> > where it would start - as I need to run macro for several times on
> > different range
> >
> > thxs
> >

Ron de Bruin · 02-15-2006, 11:55 AM

Hi al007

Try this one

Sub Summary_All_Worksheets_With_Formulas_Test()
Dim sh As Worksheet
Dim Destsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook
Dim rngaddr As String
Dim a As Integer

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

Set Basebook = ThisWorkbook
Set Destsh = Sheets("Summary-Sheet")

rngaddr = Selection.Address(False, False)

For Each sh In ActiveWindow.SelectedSheets
For a = 1 To sh.Range(rngaddr).Rows.Count
ColNum = 1
RwNum = LastRow(Destsh) + 1

Destsh.Cells(RwNum, 1).Value = sh.Name
'Copy the sheet name in the A column

For Each myCell In sh.Range(rngaddr).Rows(a).Cells
ColNum = ColNum + 1
Destsh.Cells(RwNum, ColNum).Formula = _
"='" & sh.Name & "'!" & myCell.Address(False, False)
Next myCell
Next a
Next sh

Destsh.UsedRange.Columns.AutoFit

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

--
Regards Ron de Bruin
http://www.rondebruin.nl

"al007" <transferxxx@gmail.com> wrote in message news:1139956149.886669.39170@g43g2000cwa.googlegroups.com...
> Hi Ron,
> Thxs for your prompt reply - but I did not expect all selected row of a
> sheet to be summarised in only 1 row in the summary sheet.
> I wanted it in individual row
> e,if my selected sheets are sheet1 & sheet2 & range being A1:C3
> i would expect data as follows:
> =Sheet1!A1 =Sheet1!B1 =Sheet1!C1
> =Sheet1!A2 =Sheet1!B2 =Sheet1!C2
> =Sheet1!A3 =Sheet1!B3 =Sheet1!C3
> =Sheet2!A1 =Sheet2!B1 =Sheet2!C1
> =Sheet2!A2 =Sheet2!B2 =Sheet2!C2
> =Sheet2!A3 =Sheet2!B3 =Sheet2!C3
>
> can you help pls
>
> thxs
>
>
>
>
>
>
>
> Ron de Bruin wrote:
>> Hi
>>
>> I don not like the way you want to do this with selecting more then one sheet but OK
>>
>> Note: Copy also the function in the module
>>
>> It will use this sheet
>> Set Destsh = Sheets("Summary-Sheet")
>>
>> Select the cells you want before you run the macro
>> Then select the sheets you want and run the macro
>> Every time you run the macro it will add the links below the last line
>>
>> Note : not more then 256 cells
>>
>> Sub Summary_All_Worksheets_With_Formulas_Test()
>> Dim sh As Worksheet
>> Dim Destsh As Worksheet
>> Dim myCell As Range
>> Dim ColNum As Integer
>> Dim RwNum As Long
>> Dim Basebook As Workbook
>> Dim rngaddr As String
>>
>> With Application
>> .Calculation = xlCalculationManual
>> .ScreenUpdating = False
>> End With
>>
>> Set Basebook = ThisWorkbook
>> Set Destsh = Sheets("Summary-Sheet")
>>
>> rngaddr = Selection.Address(False, False)
>>
>>
>> RwNum = LastRow(Destsh) + 1
>> 'The links to the first sheet will start in the first empty row
>>
>> For Each sh In ActiveWindow.SelectedSheets
>> ColNum = 1
>> RwNum = RwNum + 1
>>
>> Destsh.Cells(RwNum, 1).Value = sh.Name
>> 'Copy the sheet name in the A column
>>
>> For Each myCell In sh.Range(rngaddr)
>> ColNum = ColNum + 1
>> Destsh.Cells(RwNum, ColNum).Formula = _
>> "='" & sh.Name & "'!" & myCell.Address(False, False)
>> Next myCell
>> Next sh
>>
>> Destsh.UsedRange.Columns.AutoFit
>>
>> With Application
>> .Calculation = xlCalculationAutomatic
>> .ScreenUpdating = True
>> End With
>> End Sub
>>
>>
>> Function LastRow(sh As Worksheet)
>> On Error Resume Next
>> LastRow = sh.Cells.Find(What:="*", _
>> After:=sh.Range("A1"), _
>> Lookat:=xlPart, _
>> LookIn:=xlFormulas, _
>> SearchOrder:=xlByRows, _
>> SearchDirection:=xlPrevious, _
>> MatchCase:=False).Row
>> On Error GoTo 0
>> End Function
>>
>> --
>> Regards Ron de Bruin
>> http://www.rondebruin.nl
>>
>>
>> "al007" <transferxxx@gmail.com> wrote in message news:1139883450.284557.67510@g44g2000cwa.googlegroups.com...
>> >I want to create links to the cells & range can be continuous or non
>> > continuous.
>> > & as per previous post
>> > (3) Allow me to put the range to be copied in an existing sheet
>> > (instead of a new sheet) with a messge box to enter the first cell
>> > where it would start - as I need to run macro for several times on
>> > different range
>> >
>> > thxs
>> >
>

al007 · 02-16-2006, 04:40 AM

Perfect!! - Thxs a lot
Take care

Ron de Bruin wrote:
> Hi al007
>
> Try this one
>
> Sub Summary_All_Worksheets_With_Formulas_Test()
> Dim sh As Worksheet
> Dim Destsh As Worksheet
> Dim myCell As Range
> Dim ColNum As Integer
> Dim RwNum As Long
> Dim Basebook As Workbook
> Dim rngaddr As String
> Dim a As Integer
>
> With Application
> .Calculation = xlCalculationManual
> .ScreenUpdating = False
> End With
>
> Set Basebook = ThisWorkbook
> Set Destsh = Sheets("Summary-Sheet")
>
> rngaddr = Selection.Address(False, False)
>
>
> For Each sh In ActiveWindow.SelectedSheets
> For a = 1 To sh.Range(rngaddr).Rows.Count
> ColNum = 1
> RwNum = LastRow(Destsh) + 1
>
> Destsh.Cells(RwNum, 1).Value = sh.Name
> 'Copy the sheet name in the A column
>
> For Each myCell In sh.Range(rngaddr).Rows(a).Cells
> ColNum = ColNum + 1
> Destsh.Cells(RwNum, ColNum).Formula = _
> "='" & sh.Name & "'!" & myCell.Address(False, False)
> Next myCell
> Next a
> Next sh
>
> Destsh.UsedRange.Columns.AutoFit
>
> With Application
> .Calculation = xlCalculationAutomatic
> .ScreenUpdating = True
> End With
> End Sub
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
> "al007" <transferxxx@gmail.com> wrote in message news:1139956149.886669.39170@g43g2000cwa.googlegroups.com...
> > Hi Ron,
> > Thxs for your prompt reply - but I did not expect all selected row of a
> > sheet to be summarised in only 1 row in the summary sheet.
> > I wanted it in individual row
> > e,if my selected sheets are sheet1 & sheet2 & range being A1:C3
> > i would expect data as follows:
> > =Sheet1!A1 =Sheet1!B1 =Sheet1!C1
> > =Sheet1!A2 =Sheet1!B2 =Sheet1!C2
> > =Sheet1!A3 =Sheet1!B3 =Sheet1!C3
> > =Sheet2!A1 =Sheet2!B1 =Sheet2!C1
> > =Sheet2!A2 =Sheet2!B2 =Sheet2!C2
> > =Sheet2!A3 =Sheet2!B3 =Sheet2!C3
> >
> > can you help pls
> >
> > thxs
> >
> >
> >
> >
> >
> >
> >
> > Ron de Bruin wrote:
> >> Hi
> >>
> >> I don not like the way you want to do this with selecting more then one sheet but OK
> >>
> >> Note: Copy also the function in the module
> >>
> >> It will use this sheet
> >> Set Destsh = Sheets("Summary-Sheet")
> >>
> >> Select the cells you want before you run the macro
> >> Then select the sheets you want and run the macro
> >> Every time you run the macro it will add the links below the last line
> >>
> >> Note : not more then 256 cells
> >>
> >> Sub Summary_All_Worksheets_With_Formulas_Test()
> >> Dim sh As Worksheet
> >> Dim Destsh As Worksheet
> >> Dim myCell As Range
> >> Dim ColNum As Integer
> >> Dim RwNum As Long
> >> Dim Basebook As Workbook
> >> Dim rngaddr As String
> >>
> >> With Application
> >> .Calculation = xlCalculationManual
> >> .ScreenUpdating = False
> >> End With
> >>
> >> Set Basebook = ThisWorkbook
> >> Set Destsh = Sheets("Summary-Sheet")
> >>
> >> rngaddr = Selection.Address(False, False)
> >>
> >>
> >> RwNum = LastRow(Destsh) + 1
> >> 'The links to the first sheet will start in the first empty row
> >>
> >> For Each sh In ActiveWindow.SelectedSheets
> >> ColNum = 1
> >> RwNum = RwNum + 1
> >>
> >> Destsh.Cells(RwNum, 1).Value = sh.Name
> >> 'Copy the sheet name in the A column
> >>
> >> For Each myCell In sh.Range(rngaddr)
> >> ColNum = ColNum + 1
> >> Destsh.Cells(RwNum, ColNum).Formula = _
> >> "='" & sh.Name & "'!" & myCell.Address(False, False)
> >> Next myCell
> >> Next sh
> >>
> >> Destsh.UsedRange.Columns.AutoFit
> >>
> >> With Application
> >> .Calculation = xlCalculationAutomatic
> >> .ScreenUpdating = True
> >> End With
> >> End Sub
> >>
> >>
> >> Function LastRow(sh As Worksheet)
> >> On Error Resume Next
> >> LastRow = sh.Cells.Find(What:="*", _
> >> After:=sh.Range("A1"), _
> >> Lookat:=xlPart, _
> >> LookIn:=xlFormulas, _
> >> SearchOrder:=xlByRows, _
> >> SearchDirection:=xlPrevious, _
> >> MatchCase:=False).Row
> >> On Error GoTo 0
> >> End Function
> >>
> >> --
> >> Regards Ron de Bruin
> >> http://www.rondebruin.nl
> >>
> >>
> >> "al007" <transferxxx@gmail.com> wrote in message news:1139883450.284557.67510@g44g2000cwa.googlegroups.com...
> >> >I want to create links to the cells & range can be continuous or non
> >> > continuous.
> >> > & as per previous post
> >> > (3) Allow me to put the range to be copied in an existing sheet
> >> > (instead of a new sheet) with a messge box to enter the first cell
> >> > where it would start - as I need to run macro for several times on
> >> > different range
> >> >
> >> > thxs
> >> >
> >