Issues With Running xlsm files with Hyperion Add-In

R

reganj204

New Member
Joined
Aug 18, 2014
Messages
2
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:
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:

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

R
  • Question
VBA for making dynamic bucketwise report from Ageing report while providing days from Form
Replies
0
Views
748
ravi123
R
J
  • Question
VBA to extract row data to sheet and update data set
Replies
0
Views
789
justatroy
J
P
  • Question
Problem with running 2 different macros
Replies
5
Views
756
pupsia
P

Forum statistics

Threads
1,214,386
Messages
6,119,220
Members
448,876
Latest member
Solitario

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top