I have built a customizable excel spreadsheet for other editors to use; however, I have one glitch to solve before I can offer them the free download.
Cross posted here: https://www.excelforum.com/excel-ge...ing-when-new-row-added-to-previous-table.html
There are five service tables one on top of the other on a sheet. The tables start out with one data row. Users press a button attached to a macro to insert one new row at the top of the table. However, inserting rows messes up the height of various rows that need to stay at a fixed height. Every time I add a new row, I am constantly reformatting the row heights of the below tables. And once I add a ton of rows even that tables row heights get messed up.
Each table is structured like this.
Name of table in a merged cell: row height 27 (not actually part of the named table)
Grouping names color coded in merged cells (grouping certain headers in one category): row height 23.5 (not actually part of the table
Header row: row height 26
Data row(s): row height 15.5
Calculation row: row height 16
Row separating tables: row height 10
Then the next table appears with the same row heights.
Each table starts off with one row. But when I insert a row in table one, at least one of table two's row heights will change (the name of table, the grouping names, or the header row). With each new added row, more and more row heights get messed up.
In case it matters, I have put the macro codes here. But I don't think it is the codes. It just seems to be Excel default to alter the row heights, and it is driving me nuts.
Macro to insert row: (the sheet is protected to protect formulas, but it has to temporarily be unprotected to insert the row. Also since the header row is color coded, and I just want the data rows to be banded, I have the code use the formatting from a data row for the new row. This macro works perfectly)
When they get to the end of the year, the user presses a button to save the sheet, clear it, and then save it as a new name. This macro also calls out to run the restore table macro, putting all the tables back to only one data row. Since I may have had 20 data rows in one table, ten in another, etc., when this macro is run, it works perfectly, but again when it takes each table down to only one data row, the row heights of named row, grouping rows, and header rows in various tables get all messed up.
Macro to restore the tables:
Cross posted here: https://www.excelforum.com/excel-ge...ing-when-new-row-added-to-previous-table.html
There are five service tables one on top of the other on a sheet. The tables start out with one data row. Users press a button attached to a macro to insert one new row at the top of the table. However, inserting rows messes up the height of various rows that need to stay at a fixed height. Every time I add a new row, I am constantly reformatting the row heights of the below tables. And once I add a ton of rows even that tables row heights get messed up.
Each table is structured like this.
Name of table in a merged cell: row height 27 (not actually part of the named table)
Grouping names color coded in merged cells (grouping certain headers in one category): row height 23.5 (not actually part of the table
Header row: row height 26
Data row(s): row height 15.5
Calculation row: row height 16
Row separating tables: row height 10
Then the next table appears with the same row heights.
Each table starts off with one row. But when I insert a row in table one, at least one of table two's row heights will change (the name of table, the grouping names, or the header row). With each new added row, more and more row heights get messed up.
In case it matters, I have put the macro codes here. But I don't think it is the codes. It just seems to be Excel default to alter the row heights, and it is driving me nuts.
Macro to insert row: (the sheet is protected to protect formulas, but it has to temporarily be unprotected to insert the row. Also since the header row is color coded, and I just want the data rows to be banded, I have the code use the formatting from a data row for the new row. This macro works perfectly)
Code:
Sub AddRow1()
With ActiveSheet
.Unprotect Password:="Businessname30"
End With
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("ServiceTable1")
tbl.ListRows.Add (1)
tbl.ListRows(2).Range.Copy
tbl.ListRows(1).Range.PasteSpecial xlPasteFormats
tbl.ListRows(1).Range.Select
Call Formulalock
With ActiveSheet
.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True, Password:="Businessname30"
End With
End SubWhen they get to the end of the year, the user presses a button to save the sheet, clear it, and then save it as a new name. This macro also calls out to run the restore table macro, putting all the tables back to only one data row. Since I may have had 20 data rows in one table, ten in another, etc., when this macro is run, it works perfectly, but again when it takes each table down to only one data row, the row heights of named row, grouping rows, and header rows in various tables get all messed up.
Macro to restore the tables:
Code:
Sub RestoreTables()
Dim TT As ListObject
Dim ans As Long
Dim sht As Worksheet
With Sheet1
Application.ScreenUpdating = False
.Unprotect Password:="Businessname30"
.Activate
For Each TT In ActiveSheet.ListObjects
ans = TT.Range.Rows.Count
If ans > 2 Then
TT.Range.Rows("3:" & ans).Delete
End If
Next TT
.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True, Password:="Businessname30"
End With
Application.ScreenUpdating = True
With Sheet8
Application.ScreenUpdating = False
.Unprotect Password:="Businessname30"
.Activate
For Each TT In ActiveSheet.ListObjects
ans = TT.Range.Rows.Count
If ans > 2 Then
TT.Range.Rows("3:" & ans).Delete
End If
Next TT
.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True, Password:="Businessname30"
End With
Application.ScreenUpdating = True
With Sheet9
Application.ScreenUpdating = False
.Unprotect Password:="Businessname30"
.Activate
For Each TT In ActiveSheet.ListObjects
ans = TT.Range.Rows.Count
If ans > 2 Then
TT.Range.Rows("3:" & ans).Delete
End If
Next TT
.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True, Password:="Businessname30"
End With
Application.ScreenUpdating = True
With Sheet10
Application.ScreenUpdating = False
.Unprotect Password:="Businessname30"
.Activate
For Each TT In ActiveSheet.ListObjects
ans = TT.Range.Rows.Count
If ans > 2 Then
TT.Range.Rows("3:" & ans).Delete
End If
Next TT
.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True, Password:="Businessname30"
End With
Application.ScreenUpdating = True
With Sheet61
Application.ScreenUpdating = False
.Unprotect Password:="Businessname30"
.Activate
For Each TT In ActiveSheet.ListObjects
ans = TT.Range.Rows.Count
If ans > 2 Then
TT.Range.Rows("3:" & ans).Delete
End If
Next TT
.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True, Password:="Businessname30"
End With
Application.ScreenUpdating = True
With Sheet2
Application.ScreenUpdating = False
.Unprotect Password:="Businessname30"
.Activate
For Each TT In ActiveSheet.ListObjects
ans = TT.Range.Rows.Count
If ans > 2 Then
TT.Range.Rows("3:" & ans).Delete
End If
Next TT
.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True, Password:="Businessname30"
End With
Application.ScreenUpdating = True
End Sub
