Hi all
I'm trying to write a code to:

- Select values from a range on worksheet "Schedule" and copy/paste values
to worksheet "Thousands"

- then on the Thousands worksheet, add a formula to each cell in range
("AC22:DO100") to convert anything greater than zero to report Thousands.

- then copy/paste that range over itself so I'm just left with values.

- Lastly I've done a bit of cleanup work (get rid of zeros in currently
unused cells) and formatting...

Sounds easy enough but I'm a novice and I've obviously got this wrong
because my file size is blowing out because of the functions on this one
worksheet.

Where I've entered the "|" at the left margin of the code is where I think
my biggest problem is...???

(FYI: I am writing the code is a separate "Master Workbook" and it is
activated via autoopen/hide workbook and a button to keep it away from users).



Sub ConverttoThousands()
Dim txt1 As String
txt1 =
"=IF(AND(Schedule!$H22<0,Schedule!AC22<0),0,IF(AND (Schedule!$H220,Schedule!AC220),$Y22*IF($Z220,$ Z22/1000,Schedule!$CF$6/1000),Schedule!AC22))"
Application.ScreenUpdating = False
Sheets("Schedule").Select
Range("A13:DY100").Select
Selection.Copy
Range("H22").Select
Sheets("Thousands").Select
Range("A13").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Interior.ColorIndex = xlNone
Range("L13").Select
| For Each cell In Range("AC22:DO100")
| With Worksheets("Thousands")
| Range("AC22:DO100").Formula = txt1
| End With
| Next
Range("AC22:DO100").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.NumberFormat = "#,##0.00"
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("AB15").Select
ActiveCell.FormulaR1C1 = "(NOTE: All figures are in '000's)"
Columns("DR:DW").Select
Selection.ClearContents
Range("L22").Select
End Sub



--
Thank for your help
BeSmart