I have created Microsoft Excel Macro Enabled (xlsm) files containing 195 lines of VBA code (teo subroutines, two functions) and total file sizes ranging from 162 kb to 205 kb.
The files run perfectly on my computer but when my boss runs it, it takes twice as long and then the screen freezes every time she moves the cursor (this happens after the "Update" VBA program of 127 lines has been executed and completed). The only difference I can tell between our two setups is that she has a laptop and I have a desktop and she has the Hyperion Add-In and I do not.
The "Update" VBA program subroutine opens two flat files and exchange rate files, populates hardcoded balance sheet values in local currency using DSUM function, populates hardcoded foreign exchange rates, then closes the flat files and exchange rate files. After the VBA program completes, no file linkage exists.
The other program subroutine ("SS_DrillDown") is not executed when the error occurs. This program populates one cell with a Spreadsheet Server function, activates the Spreadsheet Server drill down command, then clears the cell with the Spreadsheet Server function. Spreadsheet Server is a program that enables the user to perform account balance retrieval and drill down capabilities off an AS/400 ERP system. My boss and I both have the Spreadsheet Server add-in.
Any ideas to resolve this issue? Below is the VBA code:
The files run perfectly on my computer but when my boss runs it, it takes twice as long and then the screen freezes every time she moves the cursor (this happens after the "Update" VBA program of 127 lines has been executed and completed). The only difference I can tell between our two setups is that she has a laptop and I have a desktop and she has the Hyperion Add-In and I do not.
The "Update" VBA program subroutine opens two flat files and exchange rate files, populates hardcoded balance sheet values in local currency using DSUM function, populates hardcoded foreign exchange rates, then closes the flat files and exchange rate files. After the VBA program completes, no file linkage exists.
The other program subroutine ("SS_DrillDown") is not executed when the error occurs. This program populates one cell with a Spreadsheet Server function, activates the Spreadsheet Server drill down command, then clears the cell with the Spreadsheet Server function. Spreadsheet Server is a program that enables the user to perform account balance retrieval and drill down capabilities off an AS/400 ERP system. My boss and I both have the Spreadsheet Server add-in.
Any ideas to resolve this issue? Below is the VBA code:
Code:
Sub SS_DrillDown()
SN = ActiveSheet.Name
CA = ActiveCell.Address
If SN = "Input" Or SN = "IS NOAM" Then MsgBox "You are not on a Drill Down sheet.": End
If Range(CA).Column < 3 Or Range(CA).Column > 15 Then MsgBox "You are not on a Drill Down column.": End
If Range(CA).Row < 7 Or Range("A" & Range(CA).Row).Value = 0 Then _
MsgBox "You are not on a Drill Down row.": End
Sheets("Input").Select
RR = Range("A29").End(xlDown).Row
YYYY = Range("B8").Value
MM = Range("B9").Value
BKA = Right(Range("M11").Value, 2)
If SN = "BS USD" Then BKB = "USD": Range("M17").Value = "LTD"
If SN = "BS CAD" Then BKB = "CAD": Range("M17").Value = "LTD"
If SN = "BS MXN" Then BKB = "MEX": Range("M17").Value = "LTD"
If Range("B5").Value = 1 Then BKC = "ACT"
If Range("B5").Value = 2 Then BKC = "BUD"
If Range("B5").Value = 3 Then BKC = "FOR"
If Range("B5").Value = 4 Then BKC = "ACT": Range("B8").Value = Range("B8").Value - 1
Range("M12").Value = BKA & BKB & BKC
Range("B9").Value = Range("B9").Value + Range(CA).Column - 15
If Range("B9").Value < 1 Then Range("B9").Value = Range("B9").Value + 12: _
Range("B8").Value = Range("B8").Value - 1
DC = "[": AC = "["
For I = 29 To RR
If Range("A" & I).Value = Range(CA).Row Then
If Len(AC) > 1 Then DC = DC & ",": AC = AC & ","
Range("M13").Formula = "=""[""&TEXT($C$" & I & ",""00"")&"".""&TEXT($D$" & I & ",""00"")&""]"""
Range("M14").Formula = "=""[""&TEXT($E$" & I & ",""000"")&"".""&TEXT($F$" & I & ",""000"")&""]"""
Range("M15").Formula = "=TEXT($G$" & I & ",""00000"")&"".""&TEXT($H$" & I & ",""00000"")"
Range("M16").Formula = "=TEXT($I$" & I & ",""000000"")&"".""&TEXT($J$" & I & ",""000000"")"
DC = DC & Range("M15").Value: AC = AC & Range("M16").Value
Else
End If
Next I
If AC = "[" Then MsgBox "You are not on a Drill Down row.": GoTo BADROW
Range("M15").Value = DC & "]": Range("M16").Value = AC & "]"
Range("M18").Select
Range("M18").Formula = "=GXl($M$11,$M$12,""0"",$B$8,$M$17,$B$9,$M$13,$M$14,$M$15,$M$16)"
Run ("'GSI_BPCSSSERVER.xla'!Drilldown")
BADROW:
Range("M12:M18").ClearContents
Range("B8").Value = YYYY
Range("B9").Value = MM
Sheets(SN).Select
Range(CA).Select
End Sub
Sub Update()
Dim HDN As String, HFN As String, FFD As String, FFF As String
Dim FXD As String, FXF As String, FXCYF As String, FXPYF As String, FXP As String
' Identifies home directory name (HDN) and home file name (HFN) and stores them in Excel.
Application.Calculation = xlAutomatic
Calculate
HDN = ActiveWorkbook.FullName
HFN = ActiveWorkbook.Name
HDN = Left(HDN, Len(HDN) - Len(HFN))
ChDrive (Left(HDN, 1))
ChDir HDN
Sheets("BS NOAM").Select
TR = Range("B7").SpecialCells(xlLastCell).Row
Sheets("Input").Select
Range("C1").Value = HDN
Range("H1").Value = HFN
Range("A1").Select
Application.ScreenUpdating = False ' Turns screen updating off
FFD = Range("C2").Value
FFF = " " & Range("H2").Value
FXD = Range("C3").Value
FXCYF = Range("B8").Value & " " & Range("H3").Value
FXPYF = Range("B8").Value - 1 & " " & Range("H3").Value
LDGR = Range("H4").Value
BOOK = Range("B5").Value
If Range("B6").Value = 1 Then FXP = "Actual"
If Range("B6").Value = 2 Then FXP = "Plan"
If Range("B6").Value = 3 Then FXP = "Plan"
Application.DisplayAlerts = False
If IsOpen(FXCYF) Then Else Workbooks.Open Filename:=FXD & FXCYF
If IsOpen(FXPYF) Then Else Workbooks.Open Filename:=FXD & FXPYF
Application.DisplayAlerts = True
Windows(HFN).Activate
Sheets("Input").Select
Range("E7").Formula = "=IF(ISNA(VLOOKUP(B7,'[" & FXPYF & "]" & FXP & "'!$A:$A,1,FALSE)),1,0)"
If Range("Input!E7").Value = 1 Then Range("Input!B7").Value = "LC"
Application.StatusBar = "Building Foreign Exchange and Flat File formulas ..."
For P = 0 To 12
Windows(HFN).Activate
Sheets("Input").Select
YYYY = Range("B8").Value
MM = Range("B9").Value + P
If MM > 12 Then MM = MM - 12: FXF = FXCYF Else YYYY = YYYY - 1: FXF = FXPYF
If Range("B6").Value = 2 Then FXF = FXCYF
If Range("B6").Value = 3 Then FXF = FXPYF
' Build Foreign Exchange Rates
Range(Chr(P + 69) & "7").Formula = "=IF(B7=""LC"",1," & _
"VLOOKUP(D7,'[" & FXF & "]" & FXP & "'!$A:$AA," & MM + 3 & ",FALSE)/" & _
"VLOOKUP(B7,'[" & FXF & "]" & FXP & "'!$A:$AA," & MM + 3 & ",FALSE))"
Range(Chr(P + 69) & "7").Value = Range("" & Chr(P + 69) & "7").Value
Range(Chr(P + 69) & "8").Formula = "=IF(B7=""LC"",1," & _
"VLOOKUP(D8,'[" & FXF & "]" & FXP & "'!$A:$AA," & MM + 3 & ",FALSE)/" & _
"VLOOKUP(B7,'[" & FXF & "]" & FXP & "'!$A:$AA," & MM + 3 & ",FALSE))"
Range(Chr(P + 69) & "8").Value = Range("" & Chr(P + 69) & "8").Value
Range(Chr(P + 69) & "9").Formula = "=IF(B7=""LC"",1," & _
"VLOOKUP(D9,'[" & FXF & "]" & FXP & "'!$A:$AA," & MM + 3 & ",FALSE)/" & _
"VLOOKUP(B7,'[" & FXF & "]" & FXP & "'!$A:$AA," & MM + 3 & ",FALSE))"
Range("" & Chr(P + 69) & "9").Value = Range("" & Chr(P + 69) & "9").Value
' Build Headers
Range("'BS NOAM'!" & Chr(P + 67) & 5).Value = MM
If MM > 6 Then Range("'BS NOAM'!" & Chr(P + 67) & 6).Value = YYYY _
Else Range("'BS NOAM'!" & Chr(P + 67) & 6).Value = YYYY - 1
If IsOpen(YYYY & FFF) Then Else Workbooks.Open Filename:=FFD & YYYY & FFF
Windows(HFN).Activate
Sheets("Input").Select
' Build DSUM's for Flat File
If MM > 7 Then CC = "A" & Chr(MM + 57) Else CC = Chr(MM + 83)
Range(Chr(P + 69) & "20").Formula = _
"=DSUM('[" & YYYY & FFF & "]" & Range("D20").Value & "'!$A:$AE,'[" _
& YYYY & FFF & "]" & Range("D20").Value & "'!$" & CC & "$1,$A$24:$H$25)"
Range(Chr(P + 69) & "21").Formula = _
"=DSUM('[" & YYYY & FFF & "]" & Range("D21").Value & "'!$A:$AE,'[" _
& YYYY & FFF & "]" & Range("D21").Value & "'!$" & CC & "$1,$A$24:$H$25)"
Range(Chr(P + 69) & "22").Formula = _
"=DSUM('[" & YYYY & FFF & "]" & Range("D22").Value & "'!$A:$AE,'[" _
& YYYY & FFF & "]" & Range("D22").Value & "'!$" & CC & "$1,$A$24:$H$25)"
RR = Range("A29").End(xlDown).Row
Next P
Application.StatusBar = "Clearing balance sheets ..."
For I = 29 To RR
Range("'BS USD'!C" & Range("A" & I).Value).Value = 0
Range("'BS CAD'!C" & Range("A" & I).Value).Value = 0
Range("'BS MXN'!C" & Range("A" & I).Value).Value = 0
Next I
Range("'BS USD'!C7:C" & TR).Copy Range("'BS USD'!C7:O" & TR)
Range("'BS CAD'!C7:C" & TR).Copy Range("'BS CAD'!C7:O" & TR)
Range("'BS MXN'!C7:C" & TR).Copy Range("'BS MXN'!C7:O" & TR)
For I = 29 To RR
Application.StatusBar = "Populating balance sheets, Row " & Range("A" & I).Value & " ..."
Range("A25").Value = ">=" & Range("C" & I).Value
Range("B25").Value = "<=" & Range("D" & I).Value
Range("C25").Value = ">=" & Range("E" & I).Value
Range("D25").Value = "<=" & Range("F" & I).Value
Range("E25").Value = ">=" & Range("G" & I).Value
Range("F25").Value = "<=" & Range("H" & I).Value
Range("G25").Value = ">=" & Range("I" & I).Value
Range("H25").Value = "<=" & Range("J" & I).Value
For P = 0 To 12
If Range("K" & I).Value = "-" Then
Range("'BS USD'!" & Chr(P + 67) & Range("A" & I).Value).Value = _
Range("'BS USD'!" & Chr(P + 67) & Range("A" & I).Value).Value _
- Range(Chr(P + 69) & "20").Value
Range("'BS CAD'!" & Chr(P + 67) & Range("A" & I).Value).Value = _
Range("'BS CAD'!" & Chr(P + 67) & Range("A" & I).Value).Value _
- Range(Chr(P + 69) & "21").Value
Range("'BS MXN'!" & Chr(P + 67) & Range("A" & I).Value).Value = _
Range("'BS MXN'!" & Chr(P + 67) & Range("A" & I).Value).Value _
- Range(Chr(P + 69) & "22").Value
Else
Range("'BS USD'!" & Chr(P + 67) & Range("A" & I).Value).Value = _
Range("'BS USD'!" & Chr(P + 67) & Range("A" & I).Value).Value _
+ Range(Chr(P + 69) & "20").Value
Range("'BS CAD'!" & Chr(P + 67) & Range("A" & I).Value).Value = _
Range("'BS CAD'!" & Chr(P + 67) & Range("A" & I).Value).Value _
+ Range(Chr(P + 69) & "21").Value
Range("'BS MXN'!" & Chr(P + 67) & Range("A" & I).Value).Value = _
Range("'BS MXN'!" & Chr(P + 67) & Range("A" & I).Value).Value _
+ Range(Chr(P + 69) & "22").Value
End If
Next P
Next I
Range("Input!E20:Q22").ClearContents
Range("Input!A25:H25").ClearContents
Application.ScreenUpdating = True ' Turns screen updating back on
Application.StatusBar = False ' Resets Status Bar to "Ready"
MsgBox "*** DONE ***"
End Sub
Function IsSheet(SheetName As String) As Boolean
Dim WS As Worksheet
For Each WS In Application.Worksheets
If UCase(WS.Name) = UCase(SheetName) Then
IsSheet = True
Exit Function
End If
Next WS
IsSheet = False
End Function
Function IsOpen(BookName As String) As Boolean
Dim WB As Workbook
For Each WB In Application.Workbooks
If UCase(WB.Name) = UCase(BookName) Then
IsOpen = True
Exit Function
End If
Next WB
IsOpen = False
End Function
Last edited by a moderator: