tmarinho
09-21-2017, 12:06 PM
Hi All,
I am new to VBA and inherited a macro powered process that tends to tie up my excel and then crashes half the time. It also doesn't work on other people computer most of the time. The code is below. Is there any way to really optimize it by taking out some "selects" or something. Please help:
the "Office_code = Sheets("Macro")" has a list of all the offices that need to be published.
Sub IS_Loopfile()'
' Creates and Publishes Office Income Statement Reports'
'
Application.Run "TM1RECALC"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("Macro").Select
Dim new_wbk As String
new_wbk = "Field Income Statements - Key Accounts - " & Sheets("Macro").Range("G2").Value & " - " & Sheets("Macro").Range("G3").Value & ".xlsm"
Range("A4").Select
ActiveCell.End(xlDown).Select
Endrow = ActiveCell.Row
Workbooks.Add
' newdirectory = "Y:\"
' ChDrive newdirectory
' ChDir newdirectory
ActiveWorkbook.SaveAs FileName:=new_wbk, FileFormat:=52
For i = 4 To 43
Windows("Field Income Statements - Key Accounts Controllable - New Structure v4.xlsm").Activate
Office_code = Sheets("Macro").Range("a" & i).Value
PriorOffice = Sheets("Macro").Range("a" & i - 1).Value
Office_Name = Sheets("Macro").Range("b" & i).Value
PrOffice_Name = Sheets("Macro").Range("b" & i - 1).Value
Sheets("Income Statement").Select
Range("A6").Value = Office_code 'change the range
If i = 4 Then
Sheets("Income Statement").Copy After:=Workbooks(new_wbk).Sheets(1)
Else
Sheets("Income Statement").Copy After:=Workbooks(new_wbk).Sheets(PrOffice_Name)
End If
Sheets("Income Statement").Select
Sheets("Income Statement").Name = Office_Name
ActiveSheet.Range("A1").Activate
Next i
Windows("Field Income Statements - Key Accounts Controllable - New Structure v4.xlsm").Activate
Sheets("Macro").Copy After:=Workbooks(new_wbk).Sheets(1)
Sheets("Macro").Select
Windows("Field Income Statements - Key Accounts Controllable - New Structure v4.xlsm").Activate
Sheets("Cover").Copy After:=Workbooks(new_wbk).Sheets("Macro")
Sheets("Cover").Select
Windows(new_wbk).Activate
Application.Run "TM1RECALC"
For j = 3 To 3
Windows(new_wbk).Activate
OfficeSheet = Sheets("Macro").Range("b" & j).Value
Sheets(OfficeSheet).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("A1:O1,A3:O3,A6:O6,A35:O35").Select
Selection.Merge
ActiveSheet.Range("A1").Activate
ActiveSheet.Range("H23").Select
Next j
For k = 4 To 4
Windows(new_wbk).Activate
OfficeSheet = Sheets("Macro").Range("b" & k).Value
Sheets(OfficeSheet).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'Hide Countrywide for Countrywide
Columns("U:AB").Select
Range("U16").Activate
Selection.EntireColumn.Hidden = True
ActiveSheet.Range("A1").Activate
ActiveSheet.Range("D17:AB17,D18:AB18,D19:AB19,D20:AB20,L23:S23,L24:S24,U23:AB23,U24:AB24").Select
Selection.Merge
ActiveSheet.Range("AB16").Select
Selection.Copy
ActiveSheet.Range("S16").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("A1").Activate
Next k
For l = 5 To 43
Windows(new_wbk).Activate
OfficeSheet2 = Sheets("Macro").Range("b" & l).Value
Sheets(OfficeSheet2).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("D17:AB17,D18:AB18,D19:AB19,D20:AB20,L23:S23,L24:S24,U23:AB23,U24:AB24").Select
Selection.Merge
ActiveSheet.Range("A1").Activate
Next l
Sheets("Sheet1").Delete
Tab_Color_Change
Sheets("Countrywide").Select 'Change to reflect a element in the loop range!
Application.Dialogs(xlDialogSaveAs).Show
End Sub
I am new to VBA and inherited a macro powered process that tends to tie up my excel and then crashes half the time. It also doesn't work on other people computer most of the time. The code is below. Is there any way to really optimize it by taking out some "selects" or something. Please help:
the "Office_code = Sheets("Macro")" has a list of all the offices that need to be published.
Sub IS_Loopfile()'
' Creates and Publishes Office Income Statement Reports'
'
Application.Run "TM1RECALC"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("Macro").Select
Dim new_wbk As String
new_wbk = "Field Income Statements - Key Accounts - " & Sheets("Macro").Range("G2").Value & " - " & Sheets("Macro").Range("G3").Value & ".xlsm"
Range("A4").Select
ActiveCell.End(xlDown).Select
Endrow = ActiveCell.Row
Workbooks.Add
' newdirectory = "Y:\"
' ChDrive newdirectory
' ChDir newdirectory
ActiveWorkbook.SaveAs FileName:=new_wbk, FileFormat:=52
For i = 4 To 43
Windows("Field Income Statements - Key Accounts Controllable - New Structure v4.xlsm").Activate
Office_code = Sheets("Macro").Range("a" & i).Value
PriorOffice = Sheets("Macro").Range("a" & i - 1).Value
Office_Name = Sheets("Macro").Range("b" & i).Value
PrOffice_Name = Sheets("Macro").Range("b" & i - 1).Value
Sheets("Income Statement").Select
Range("A6").Value = Office_code 'change the range
If i = 4 Then
Sheets("Income Statement").Copy After:=Workbooks(new_wbk).Sheets(1)
Else
Sheets("Income Statement").Copy After:=Workbooks(new_wbk).Sheets(PrOffice_Name)
End If
Sheets("Income Statement").Select
Sheets("Income Statement").Name = Office_Name
ActiveSheet.Range("A1").Activate
Next i
Windows("Field Income Statements - Key Accounts Controllable - New Structure v4.xlsm").Activate
Sheets("Macro").Copy After:=Workbooks(new_wbk).Sheets(1)
Sheets("Macro").Select
Windows("Field Income Statements - Key Accounts Controllable - New Structure v4.xlsm").Activate
Sheets("Cover").Copy After:=Workbooks(new_wbk).Sheets("Macro")
Sheets("Cover").Select
Windows(new_wbk).Activate
Application.Run "TM1RECALC"
For j = 3 To 3
Windows(new_wbk).Activate
OfficeSheet = Sheets("Macro").Range("b" & j).Value
Sheets(OfficeSheet).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("A1:O1,A3:O3,A6:O6,A35:O35").Select
Selection.Merge
ActiveSheet.Range("A1").Activate
ActiveSheet.Range("H23").Select
Next j
For k = 4 To 4
Windows(new_wbk).Activate
OfficeSheet = Sheets("Macro").Range("b" & k).Value
Sheets(OfficeSheet).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'Hide Countrywide for Countrywide
Columns("U:AB").Select
Range("U16").Activate
Selection.EntireColumn.Hidden = True
ActiveSheet.Range("A1").Activate
ActiveSheet.Range("D17:AB17,D18:AB18,D19:AB19,D20:AB20,L23:S23,L24:S24,U23:AB23,U24:AB24").Select
Selection.Merge
ActiveSheet.Range("AB16").Select
Selection.Copy
ActiveSheet.Range("S16").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("A1").Activate
Next k
For l = 5 To 43
Windows(new_wbk).Activate
OfficeSheet2 = Sheets("Macro").Range("b" & l).Value
Sheets(OfficeSheet2).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("D17:AB17,D18:AB18,D19:AB19,D20:AB20,L23:S23,L24:S24,U23:AB23,U24:AB24").Select
Selection.Merge
ActiveSheet.Range("A1").Activate
Next l
Sheets("Sheet1").Delete
Tab_Color_Change
Sheets("Countrywide").Select 'Change to reflect a element in the loop range!
Application.Dialogs(xlDialogSaveAs).Show
End Sub