Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 420
Default Macro for Multiple Worksheets

Check out the formulas that were added. I think they're including the cells
with the formula. And that can't be right.

Maybe the formulas need to be adjusted--that LastRow may not be what you expect.

On 07/15/2010 14:12, Excel Hates Me wrote:
THANK YOU!
THANK YOU!
Worked like a charm. I am receiving a circular reference box but it
doesn't seem to affect anything. I will try to figure out how you did
that :) Much appreciated!


--
Dave Peterson
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11
Default Macro for Multiple Worksheets

Found it. The macro that breaks out my data to multiple tabs creates
an additional blank sheet at the end, called (e.g.) Sheet11. So I end
up with a circular reference on that sheet when I run the next macro
(above). Not sure if there is something I can do to edit the code or a
macro to delete the blank sheet.

Sub BreakoutTabs()
' delete top 3 rows
Rows("2:5").Select
Range("A3").Activate
Selection.Delete Shift:=xlUp
Range("A1").Select

' format worksheet
Selection.AutoFormat Format:=xlRangeAutoFormatList3, Number:=True,
Font:= _
True, Alignment:=True, Border:=True, Pattern:=True,
Width:=True

' begin breakout
Dim strSrcSheet As String
Dim rngSrcStart As Range
Dim rngSrcEnd As Range
Dim rngCell As Range
Dim strLastDept As String
Dim intDestRow As Integer

On Error GoTo ErrHnd

'name of source data worksheet (tab)
strSrcSheet = "SrcData"

With ActiveWorkbook
'setup source range in column D
Set rngSrcStart = .Worksheets(strSrcSheet).Range("D2")
Set rngSrcEnd = .Worksheets(strSrcSheet).Range("D65534").End(xlUp)

'set destination row counter
intDestRow = 1
'set last department name
strLastDept = ""

'loop through cells in column D
For Each rngCell In Range(rngSrcStart, rngSrcEnd)
'test if policy info change
If rngCell.Text < strLastDept Then
'create new sheet
.Worksheets.Add After:=.Worksheets(Worksheets.count)
'name new sheet
.Worksheets(Worksheets.count).Name = rngCell.Text
'copy header row
.Worksheets(strSrcSheet).Range("A1").EntireRow.Cop y _
Destination:=.Worksheets(rngCell.Text).Range("A1")
'reset variables
strLastDept = rngCell.Text
intDestRow = 1

End If
'copy entire row
rngCell.EntireRow.Copy _

Destination:=.Worksheets(strLastDept).Range("A1"). Offset(intDestRow,
0)
'increment row counter
intDestRow = intDestRow + 1
Next rngCell

End With
Exit Sub
'error handler
ErrHnd:
Err.Clear
End Sub
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 420
Default Macro for Multiple Worksheets

You could add another check in the other code that looks to see what's been used
in each sheet before continuing:

Option Explicit
Sub AllSheetFunctions()

Dim ws As Worksheet
Dim NextCell As Range
Dim LastRow As Long

'why select all the sheets first?
'Worksheets.Select
'For Each ws In ActiveWindow.SelectedSheets

' begin repeat for all worksheets
For Each ws In ActiveWorkbook.Worksheets
With ws
If .UsedRange.Address = "$A$1" Then
'skip it
Else
'do the work
.UsedRange.Columns.AutoFit

Set NextCell = .Cells(.Rows.Count, "G").End(xlUp).Offset(1, 0)

' Bold cell and add text
With NextCell
.Font.Bold = True
.Value = "Count"

.Offset(0, 1).Font.Bold = True
End With

' Add formula to blank cell at bottom of column 8
LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
.Cells(LastRow, 8).Formula = "=COUNTA(H2:H" & LastRow - 1 & ")"

' Move eight cells to right, bold and add text
With .Cells(LastRow, 16)
.Font.Bold = True
.FormulaR1C1 = "Totals"
End With

With .Cells(LastRow, 17)
.Font.Bold = True
.Formula = "=SUM(Q2:Q" & LastRow - 1 & ")"
End With
End If
End With

Next ws

End Sub


On 07/15/2010 20:59, Excel Hates Me wrote:
Found it. The macro that breaks out my data to multiple tabs creates
an additional blank sheet at the end, called (e.g.) Sheet11. So I end
up with a circular reference on that sheet when I run the next macro
(above). Not sure if there is something I can do to edit the code or a
macro to delete the blank sheet.

Sub BreakoutTabs()
' delete top 3 rows
Rows("2:5").Select
Range("A3").Activate
Selection.Delete Shift:=xlUp
Range("A1").Select

' format worksheet
Selection.AutoFormat Format:=xlRangeAutoFormatList3, Number:=True,
Font:= _
True, Alignment:=True, Border:=True, Pattern:=True,
Width:=True

' begin breakout
Dim strSrcSheet As String
Dim rngSrcStart As Range
Dim rngSrcEnd As Range
Dim rngCell As Range
Dim strLastDept As String
Dim intDestRow As Integer

On Error GoTo ErrHnd

'name of source data worksheet (tab)
strSrcSheet = "SrcData"

With ActiveWorkbook
'setup source range in column D
Set rngSrcStart = .Worksheets(strSrcSheet).Range("D2")
Set rngSrcEnd = .Worksheets(strSrcSheet).Range("D65534").End(xlUp)

'set destination row counter
intDestRow = 1
'set last department name
strLastDept = ""

'loop through cells in column D
For Each rngCell In Range(rngSrcStart, rngSrcEnd)
'test if policy info change
If rngCell.Text< strLastDept Then
'create new sheet
.Worksheets.Add After:=.Worksheets(Worksheets.count)
'name new sheet
.Worksheets(Worksheets.count).Name = rngCell.Text
'copy header row
.Worksheets(strSrcSheet).Range("A1").EntireRow.Cop y _
Destination:=.Worksheets(rngCell.Text).Range("A1")
'reset variables
strLastDept = rngCell.Text
intDestRow = 1

End If
'copy entire row
rngCell.EntireRow.Copy _

Destination:=.Worksheets(strLastDept).Range("A1"). Offset(intDestRow,
0)
'increment row counter
intDestRow = intDestRow + 1
Next rngCell

End With
Exit Sub
'error handler
ErrHnd:
Err.Clear
End Sub


--
Dave Peterson
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
run macro in multiple worksheets SteveDB1 Excel Programming 9 June 13th 08 04:29 PM
how to make a macro to clear multiple cells from multiple worksheets? [email protected] Excel Worksheet Functions 2 October 18th 07 04:31 PM
Run a macro on multiple worksheets? J@Y Excel Discussion (Misc queries) 3 February 3rd 07 10:24 AM
Use a macro on multiple Worksheets Bwoods Excel Discussion (Misc queries) 1 March 19th 06 11:20 PM
Macro for multiple worksheets Amber[_3_] Excel Programming 3 January 20th 06 08:51 PM


All times are GMT +1. The time now is 08:55 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"