Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
run macro in multiple worksheets | Excel Programming | |||
how to make a macro to clear multiple cells from multiple worksheets? | Excel Worksheet Functions | |||
Run a macro on multiple worksheets? | Excel Discussion (Misc queries) | |||
Use a macro on multiple Worksheets | Excel Discussion (Misc queries) | |||
Macro for multiple worksheets | Excel Programming |