B
BeSmart
Hi all
I have a code using defined ranges....
The defined range on a worksheet called "Schedule" will increase/decrease in
size based on users inserting/deleting rows.
When the code copies/pastes values/formats data on a second worksheet
(called "Thousands") it uses defined ranges to format the data, but it's
missing rows because the defined areas of worksheet "Thousands" no longer
match those of "Schedule"....
How do I write the code to format data on the worksheet "Thousands" when the
number of rows increases/decreases each time?
Defined names and ranges used in code:
"FullThousands" =Thousands!$1:$65536
"Pasteschedule2" =Thousands!$A$13:$DZ$100
"Schedule" =Schedule!$A$13:$DZ$71
"Pasteposition" =Thousands!$A$13
"Thousandsspots" =Thousands!$AC$22:$DP$100
"Sortarea" =Thousands!$A$22:$DZ$100
"Subtotals" =Thousands!$A$21:$DZ$100
"Unusedtotals" =Thousands!$DS:$DX
What the code does:-
For Worksheet "Thousands"
(These steps clear prior formatting to start with a clean range)
- Select entire worksheet ("FullThousands") and clear current subtotalling
- Select all rows from 13 onwards (range defined as "Pasteschedule2") and
clear contents.
===================================
I think the above is causing my defined areas to change....?
===================================
For Worksheet "Schedule"
- Copies defined range named "Schedule".
For Worksheet "Thousands"
- Pastes that data (pasting formatting and values only) starting at a
defined range named "Pasteposition"
- Select all again ("FullThousands") and clear interior Colouring.
- Select defined range "Thousandsspots"
- paste a formula in each cell to convert spots to thousands
- format the numbers
- copy and paste values only to get rid of formulas.
- Find and replace any zero cells with "".
- Sorts all columns in defined range named "Sortarea" into ascending order
based on data in column "L"
- Subtotals all columns in defined range named "Subtotals" based on data in
column "L" and only show the totals
===========================
This looks bad because the Grand Total ends up many rows below the totals
===========================
Lastly there is some basic formatting...
Here is the current code:
Sub Thousands()
Dim txt1 As String
txt1 =
"=IF(AND(Schedule!$H22<0,Schedule!AC22<0),0,IF(AND(Schedule!$H22>0,Schedule!AC22>0),$Y22*IF($Z22>0,$Z22/1000,Schedule!$CF$6/1000),Schedule!AC22))"
Application.ScreenUpdating = False
Application.Goto Reference:="FullThousands"
Selection.RemoveSubtotal
Application.Goto Reference:="pastedschedule2"
Selection.Clear
Range("L22").Select
With ThisWorkbook.Names("Schedule").RefersToRange
.Copy
With ThisWorkbook.Names("Pasteposition").RefersToRange
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Application.Goto Reference:="FullThousands"
Application.CutCopyMode = False
Selection.Interior.ColorIndex = xlNone
With ThisWorkbook.Names("Thousandsspots").RefersToRange
.Formula = txt1
.Copy
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
.NumberFormat = "#,##0.00"
With .Font
.Name = "Tahoma"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
Range("L22").Select
Application.Goto Reference:="Sortarea"
Selection.Sort Key1:=Range("L22"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.DisplayAlerts = False
Application.Goto Reference:="Subtotalarea"
Selection.Subtotal GroupBy:=12, Function:=xlSum, TotalList:=Array(29,
30, _
31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,
48, 49, 50, 51, 52, 53, 54, 55, 56, _
57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73,
74, 75, 76, 77, 78, 79, 80, 81, 82, _
83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99,
100, 101, 102, 103, 104, 105, 106, _
107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119,
121, 122, 129, 130), Replace _
:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Application.DisplayAlerts = True
Range("AB15").Select
ActiveCell.FormulaR1C1 = "(NOTE: All figures are in '000's)"
With ThisWorkbook.Names("Unusedtotals").RefersToRange
.ClearContents
End With
Application.ScreenUpdating = True
End With
End With
End Sub
I have a code using defined ranges....
The defined range on a worksheet called "Schedule" will increase/decrease in
size based on users inserting/deleting rows.
When the code copies/pastes values/formats data on a second worksheet
(called "Thousands") it uses defined ranges to format the data, but it's
missing rows because the defined areas of worksheet "Thousands" no longer
match those of "Schedule"....
How do I write the code to format data on the worksheet "Thousands" when the
number of rows increases/decreases each time?
Defined names and ranges used in code:
"FullThousands" =Thousands!$1:$65536
"Pasteschedule2" =Thousands!$A$13:$DZ$100
"Schedule" =Schedule!$A$13:$DZ$71
"Pasteposition" =Thousands!$A$13
"Thousandsspots" =Thousands!$AC$22:$DP$100
"Sortarea" =Thousands!$A$22:$DZ$100
"Subtotals" =Thousands!$A$21:$DZ$100
"Unusedtotals" =Thousands!$DS:$DX
What the code does:-
For Worksheet "Thousands"
(These steps clear prior formatting to start with a clean range)
- Select entire worksheet ("FullThousands") and clear current subtotalling
- Select all rows from 13 onwards (range defined as "Pasteschedule2") and
clear contents.
===================================
I think the above is causing my defined areas to change....?
===================================
For Worksheet "Schedule"
- Copies defined range named "Schedule".
For Worksheet "Thousands"
- Pastes that data (pasting formatting and values only) starting at a
defined range named "Pasteposition"
- Select all again ("FullThousands") and clear interior Colouring.
- Select defined range "Thousandsspots"
- paste a formula in each cell to convert spots to thousands
- format the numbers
- copy and paste values only to get rid of formulas.
- Find and replace any zero cells with "".
- Sorts all columns in defined range named "Sortarea" into ascending order
based on data in column "L"
- Subtotals all columns in defined range named "Subtotals" based on data in
column "L" and only show the totals
===========================
This looks bad because the Grand Total ends up many rows below the totals
===========================
Lastly there is some basic formatting...
Here is the current code:
Sub Thousands()
Dim txt1 As String
txt1 =
"=IF(AND(Schedule!$H22<0,Schedule!AC22<0),0,IF(AND(Schedule!$H22>0,Schedule!AC22>0),$Y22*IF($Z22>0,$Z22/1000,Schedule!$CF$6/1000),Schedule!AC22))"
Application.ScreenUpdating = False
Application.Goto Reference:="FullThousands"
Selection.RemoveSubtotal
Application.Goto Reference:="pastedschedule2"
Selection.Clear
Range("L22").Select
With ThisWorkbook.Names("Schedule").RefersToRange
.Copy
With ThisWorkbook.Names("Pasteposition").RefersToRange
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Application.Goto Reference:="FullThousands"
Application.CutCopyMode = False
Selection.Interior.ColorIndex = xlNone
With ThisWorkbook.Names("Thousandsspots").RefersToRange
.Formula = txt1
.Copy
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
.NumberFormat = "#,##0.00"
With .Font
.Name = "Tahoma"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
Range("L22").Select
Application.Goto Reference:="Sortarea"
Selection.Sort Key1:=Range("L22"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.DisplayAlerts = False
Application.Goto Reference:="Subtotalarea"
Selection.Subtotal GroupBy:=12, Function:=xlSum, TotalList:=Array(29,
30, _
31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,
48, 49, 50, 51, 52, 53, 54, 55, 56, _
57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73,
74, 75, 76, 77, 78, 79, 80, 81, 82, _
83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99,
100, 101, 102, 103, 104, 105, 106, _
107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119,
121, 122, 129, 130), Replace _
:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Application.DisplayAlerts = True
Range("AB15").Select
ActiveCell.FormulaR1C1 = "(NOTE: All figures are in '000's)"
With ThisWorkbook.Names("Unusedtotals").RefersToRange
.ClearContents
End With
Application.ScreenUpdating = True
End With
End With
End Sub