Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 ad8c3d3e50daa56f…

MALICIOUS

Office (OOXML)

1.33 MB Created: 2016-06-27 09:21:24 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2019-09-30
MD5: 7d53cda4a619f49c27d2f61289cb5aed SHA-1: 77f668aa794ebdf7c55a44b3659b73836829c934 SHA-256: ad8c3d3e50daa56f54034db1c2fcdf8900b55a0ae82d10d6559e6e032c2667ac
138 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File T1566.001 Spearphishing Attachment

The OOXML document contains a Workbook_Open VBA macro that utilizes the Shell() function, indicating an attempt to execute arbitrary commands. This macro is designed to run automatically when the document is opened, suggesting a malicious intent to download and execute further stages. The presence of hidden sheets and PEB access heuristics further supports a malicious classification.

Heuristics 6

  • VBA project inside OOXML medium 2 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
    260             errorDesc = Now() & ", ReportId : " & reportId & ", Function : " & functionName & ", Error# : " & Err.Number & ", Description : " & Err.Description & ", Line# : " & Erl
270             Shell "eventcreate /Id 101 /D  """ & errorDesc & """ /T ERROR /L """ & excelEvent & """ "
            End If
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Private Sub Workbook_Open()
        On Error GoTo ErrorHandler
  • PEB access via FS segment (x86) high SC_PEB_ACCESS
    PEB access via FS segment (x86)
    Disassembly
    Attempted x86 opcode disassembly
    00137AA5  648b5230          mov edx, dword ptr fs:[edx + 0x30]
00137AA9  db                .byte 0xdb
00137AAA  a2b781d9d6        mov byte ptr [0xd6d981b7], al
00137AAF  ac                lodsb al, byte ptr [esi]
00137AB0  036a9b            add ebp, dword ptr [edx - 0x65]
00137AB3  f4                hlt
00137AB4  216f43            and dword ptr [edi + 0x43], ebp
00137AB7  2b7959            sub edi, dword ptr [ecx + 0x59]
00137ABA  1f                pop ds
00137ABB  6b328a            imul esi, dword ptr [edx], -0x76
00137ABE  862b              xchg byte ptr [ebx], ch
00137AC0  aa                stosb byte ptr es:[edi], al
00137AC1  3e4a              dec edx
00137AC3  328aca6e559f      xor cl, byte ptr [edx - 0x60aa9136]
00137AC9  2c19              sub al, 0x19
00137ACB  657d38            jge 0x137b06
00137ACE  0ab27dacc928      or dh, byte ptr [edx + 0x28c9ac7d]
00137AD4  98                cwde
00137AD5  6d                insd dword ptr es:[edi], dx
00137AD6  55                push ebp
00137AD7  1f                pop ds
00137AD8  251905a7ad        and eax, 0xada70519
00137ADD  eaa325a3332519    ljmp 0x1925:0x33a325a3
00137AE4  05a96d9b0d        add eax, 0xd9b6da9
00137AE9  d0e7              shl bh, 1
00137AEB  5e                pop esi
00137AEC  d547              aad 0x47
00137AEE  49                dec ecx
00137AEF  46                inc esi
00137AF0  d100              rol dword ptr [eax], 1
00137AF2  5f                pop edi
00137AF3  d307              rol dword ptr [edi], cl
00137AF5  94                xchg esp, eax
00137AF6  b68c              mov dh, 0x8c
00137AF8  1f                pop ds
00137AF9  1475              adc al, 0x75
00137AFB  8bfe              mov edi, esi
00137AFD  86a2eeb23e5c      xchg byte ptr [edx + 0x5c3eb2ee], ah
00137B03  6a8a              push -0x76
  • Hidden worksheet (hidden) low OOXML_HIDDEN_SHEET
    Excel workbook contains 10 hidden sheet(s) — hidden sheets are commonly used to conceal macro code, staging data, or intermediate payload construction
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL https://www.mathsisfun.com/median.html In document text (OOXML body / shared strings)
    • http://www.w3.org/1999/02/22-rdf-syntax-ns#In document text (OOXML body / shared strings)
    • http://ns.adobe.com/xap/1.0/In document text (OOXML body / shared strings)
    • http://ns.adobe.com/xap/1.0/mm/In document text (OOXML body / shared strings)
    • http://ns.adobe.com/xap/1.0/sType/ResourceRef#In document text (OOXML body / shared strings)

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 168546 bytes
SHA-256: f8288c0a85c102df63ea42d7acf3e737814bddd37bac5574eba12b265654482e
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
' v6.0 - 25072018 - 1621IST

Dim CalculationSetting As Integer
Dim ScreenUpdating As Boolean
Dim DisplayStatusBar  As Boolean
Dim EnableEvents  As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
        On Error GoTo ErrorHandler
        Application.Calculation = xlCalculationAutomatic
        'Call LogEventTest
        ' Restore Client Settings
10      'Application.Calculation = CalculationSetting
20      'Application.ScreenUpdating = ScreenUpdating
30      'Application.DisplayStatusBar = DisplayStatusBar
40      'Application.EnableEvents = EnableEvents
            Exit Sub
ErrorHandler:
50          Call Module33.LogEvent(Err, "ThisWorkbook.Workbook_BeforeClose", Erl)
60          Call Module33.ErrorHandler
End Sub

Private Sub LogEventTest()
    On Error GoTo ErrorHandler
10    Dim t As Integer
20      t = 7 / 0
ErrorHandler:
50          Call Module33.LogEvent(Err, "ThisWorkbook.TestLog", Erl)
 End Sub
 
Private Sub Workbook_Open()
        On Error GoTo ErrorHandler
        
        ' Store Client Settings
70      CalculationSetting = Application.Calculation
80      ScreenUpdating = Application.ScreenUpdating
90      DisplayStatusBar = Application.DisplayStatusBar
100      EnableEvents = Application.EnableEvents
        
            'Sheet2.CommandButton1_Click
110    Application.Calculation = xlCalculationManual
111         Call Module31.FreezePane
        '    Sheet1.Visible = xlSheetHidden
        '    Sheet8.Visible = xlSheetHidden
120     If Sheet2.Cells(1, 30) = "1" Then
130         Call Module33.OptimizeCode_End_ExceptCalculation
                End
            End If
140     Call Module32.RunInitialMacros
            Exit Sub
ErrorHandler:
150         Call Module33.LogEvent(Err, "ThisWorkbook.Workbook_Open", Erl)
160         Call Module33.ErrorHandler
        End Sub
        
        Sub FillSupplyLOSCB()
            On Error GoTo ErrorHandler
            Dim startTime As Date
170     startTime = Now()

180         If ThisWorkbook.sheetExists("Sheet9") And Range("Sheet3!A3") > "" Then
         'Call FillComboFromSheet(Sheet9.CB_Supply_LOS, "listLOS1")
190          Call Module8.FillDropDownFromSheet(Sheet9, Sheet9.Shapes("dd_Supply_LOS"), "listLOS1", ThisWorkbook.Settings("SupplyLOS"))
        '    Dim val As String
        '    val = Sheet1.Cells(5, 1)
        '    If val > "" Then
        '        Sheet9.CB_Supply_LOS.Clear
        '        Sheet9.CB_Supply_LOS.List = Split(val, ",")
        '        Sheet9.CB_Supply_LOS.Text = Sheet9.CB_Supply_LOS.List(0)
        '    End If
        End If
200      Call Module33.LogTime("FillSupplyLOSCB", startTime, Now())
            Exit Sub
ErrorHandler:
210          Call Module33.LogEvent(Err, "ThisWorkbook.FillSupplyLOSCB", Erl)
220          Call Module33.ErrorHandler
        End Sub
        
        Sub FillOverviewLOSCB()
             On Error GoTo ErrorHandler
            Dim startTime As Date
230      startTime = Now()
240          If ThisWorkbook.sheetExists("Sheet4") And Range("Sheet3!A3") > "" Then
            
250      Call Module8.FillDropDownFromSheet(Sheet4, Sheet4.Shapes("dd_Overvw_LOS"), "listLOS1", ThisWorkbook.Settings("OverviewLOS"))
        'Call FillComboFromSheet(Sheet4.cb_Overvw_LOS, "listLOS1")
            
        '    Dim val As String
        '    val = Sheet4.cb_Overvw_LOS.value
        '    If val = "" Then
        '        Sheet4.cb_Overvw_LOS.ListFillRange = ""
        '        Sheet4.cb_Overvw_LOS.ListFillRange = "ListLOS"
        '        Sheet4.cb_Overvw_LOS.Text = Sheet4.cb_Overvw_LOS.List(0)
        '    End If
            
            Dim val2 As String
260          val2 = Sheet4.Cells(10, 1)
270          If val2 = "" Then
280              Call ThisWorkbook.FillOverviewStaticData
            End If
                
        '    Dim val As String
        '    val = Sheet8.Cells(51, 1)
        '    If val > "" Then
        '        Sheet4.cb_Overvw_LOS.Clear
        '        Sheet4.cb_Overvw_LOS.List = Split(val, ",")
        '        Sheet4.cb_Overvw_LOS.Text = Sheet4.cb_Overvw_LOS.List(0)
        '
        '        Dim val2 As String
        '        val2 = Sheet4.Cells(10, 1)
        '        If val2 = "" Then
        '            Call ThisWorkbook.FillOverviewStaticData
        '        End If
        '    End If
            End If
290      Call Module33.LogTime("FillOverviewLOSCB", startTime, Now())
            Exit Sub
ErrorHandler:
300          Call Module33.LogEvent(Err, "ThisWorkbook.FillOverviewLOSCB", Erl)
310          Call Module33.ErrorHandler
        End Sub
        
        Sub FillParityLOSCB()
            On Error GoTo ErrorHandler
            Dim startTime As Date
320      startTime = Now()
            
330      If ThisWorkbook.sheetExists("Sheet12") And Range("Sheet3!A3") > "" Then
            'Call FillComboFromSheet(Sheet12.cb_Parity_LOS, "listLOS1")
        
340      Call Module8.FillDropDownFromSheet(Sheet12, Sheet12.Shapes("dd_Parity_LOS"), "listLOS1", ThisWorkbook.Settings("ParityLOS"))
                
        '        Dim val As String
        '        val = Sheet19.Cells(5, 1)
        '        If val > "" Then
        '            Sheet12.cb_Parity_LOS.Clear
        '            Sheet12.cb_Parity_LOS.List = Split(val, ",")
        '            Sheet12.cb_Parity_LOS.Text = Sheet12.cb_Parity_LOS.List(0)
        '        End If
            End If
            
350      Call Module33.LogTime("FillParityLOSCB", startTime, Now())
            Exit Sub
ErrorHandler:
360          Call Module33.LogEvent(Err, "ThisWorkbook.FillParityLOSCB", Erl)
370          Call Module33.ErrorHandler
        End Sub
        
        Sub FillOverviewStaticData()
            On Error GoTo ErrorHandler
            Dim startTime As Date
380      startTime = Now()
        
            Dim comps As Integer
            Dim los As Integer
            Dim days As Integer
            
390      comps = IIf(Sheet8.Cells(53, 1) > "", Sheet8.Cells(53, 1), 0)
        'los = IIf(Sheet4.cb_Overvw_LOS.value > "", Sheet4.cb_Overvw_LOS.value, 0)
400      days = IIf(Sheet8.Cells(50, 1) > "", Sheet8.Cells(50, 1), 0)
            
410      If comps > 0 And days > 0 Then
             Dim r As Range
             
             ' Copying Column Headings
420       Set r = Sheet8.Cells(61, 1)
             
430       Sheet8.Visible = True
440       Sheet8.Activate
450       Sheet8.Select
460       r.Resize(, (r.Columns.Count + days + 1)).Select
             
470       Application.CutCopyMode = False
            
480       Selection.Copy
490       Sheet8.Visible = False
             
500       Sheet4.Select
             
510       With Range("A10")
520          .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
530              .PasteSpecial xlPasteFormats
540                      .PasteSpecial xlPasteColumnWidths
550                      .PasteSpecial xlPasteComments
                 End With
                 
560       Sheet4.Range("A8").Select
             
             ' Copying Row Headings
570       Set r = Sheet8.Cells(62, 1)
             
580       Sheet8.Visible = True
590       Sheet8.Activate
600       Sheet8.Select
610       r.Resize(r.Rows.Count + comps * 3, (r.Columns.Count + 1)).Select
             
620       Application.CutCopyMode = False
            
630       Selection.Copy
640       Sheet8.Visible = False
             
650       Sheet4.Select
660       Sheet4.Range("A11").Select
670       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
680           Selection.PasteSpecial xlPasteFormats
690           Selection.PasteSpecial xlPasteColumnWidths
700           Selection.PasteSpecial xlPasteComments
                 
710       Sheet4.Range("A10").Select
             
             
720       Application.CutCopyMode = False
            
            End If
            
730      Call Module33.LogTime("FillOverviewStaticData", startTime, Now())
            Exit Sub
ErrorHandler:
740          Call Module33.LogEvent(Err, "ThisWorkbook.FillOverviewStaticData", Erl)
750          Call Module33.ErrorHandler
        End Sub
        
        Function sheetExists(sheetToFind As String) As Boolean
760      sheetExists = False
770      For Each sheet In Worksheets
780          If sheetToFind = sheet.CodeName Then
790              sheetExists = True
                    Exit Function
                End If
800      Next sheet
        End Function
        
        
        Public Function Settings(key As String)
        On Error GoTo ErrorHandler
810  Select Case key
          Case "ParityLOS": Settings = "H"
830      Case "SupplyLOS": Settings = "I"
840      Case "OverviewLOS": Settings = "J"
850      Case "RDRestriction": Settings = "K"
860      Case "RDQualification": Settings = "L"
870      Case "RDPromotion": Settings = "M"
880      Case "RDLOS": Settings = "N"
890      Case "RDProduct": Settings = "O"
900      Case "RDInclusion": Settings = "P"
910      Case "LinkCell": Settings = 39
920      Case "FilledCell": Settings = 40
    End Select
            Exit Function
ErrorHandler:
930          Call Module33.LogEvent(Err, "ThisWorkbook.Settings", Erl)
940          Call Module33.ErrorHandler
End Function









Attribute VB_Name = "Module29"
        Sub RateFormatting()
        On Error GoTo ErrorHandler
        Dim startTime As Date
10      startTime = Now()
        
            Dim LowFormula As String
            Dim HighFormula As String
            
            Dim isFormatted As String
20          isFormatted = Sheet15.Cells(1, 10)
            
30          If isFormatted = "" Then
                Dim prop As Integer
                Dim channels As Integer
                Dim days As Integer
                
40              channels = Sheet15.Cells(7, 1)
50              prop = Sheet15.Cells(6, 1)
60              days = Sheet15.Cells(3, 1)
                
                Dim Cells As String
                Dim ThreshCells As String
                ' Cells = "K15,K19,K23,K31,K27,K35"
70              Sheet5.Activate
                
                Dim startRow As Long
                Dim subsRow As Long
                Dim startCol As Long
80              startRow = 14
90              For lchn = 1 To channels Step 1
100                 Cells = ""
110                 startCol = 4
                    subsRow = startRow
120                 For lprop = 1 To prop Step 1
130                     Cells = Cells & "~" & startRow & ","
140                     startRow = startRow + 4
150                 Next
160                 Cells = left(Cells, Len(Cells) - 1)
170                 ThreshCells = Right(Cells, Len(Cells) - InStr(Cells, ","))
                    Dim PrevColName As String
                    Dim NewColName As String
180                 PrevColName = "~"
190                 For ldates = 1 To days Step 1
200                     LowFormula = "=AND(($O$7=TRUE),(($~$" & subsRow & "-$~" & (subsRow + 4) & " ) > IF(VLOOKUP($B" & (subsRow + 4) & " ,RateFilters!$B$11:$E$100,2,0)=""--"",VLOOKUP($B" & (subsRow + 4) & ",RateFilters!$B$11:$E$100,3,0)*$~$" & (subsRow) & " *0.01,VLOOKUP($B" & (subsRow + 4) & " ,RateFilters!$B$11:$E$100,2,0))))"
210                     HighFormula = "=AND(($O$8=TRUE),(($~" & (subsRow + 4) & "-$~$" & (subsRow) & " ) > IF(VLOOKUP($B" & (subsRow + 4) & " ,RateFilters!$B$11:$E$100,4,0)=""--"",VLOOKUP($B" & (subsRow + 4) & ",RateFilters!$B$11:$E$100,5,0)*$~$" & (subsRow) & " *0.01,VLOOKUP($B" & (subsRow + 4) & " ,RateFilters!$B$11:$E$100,4,0))))"
220                     NewColName = Module30.ColumnNameFromNo(startCol)
230                     Cells = Replace(Cells, PrevColName, NewColName)
240                     ThreshCells = Replace(ThreshCells, PrevColName, NewColName)
250                     LowFormula = Replace(LowFormula, "~", NewColName)
260                     HighFormula = Replace(HighFormula, "~", NewColName)
270                     PrevColName = NewColName
280                     startCol = startCol + 1
                        
290                     Call ApplyHighLowFormatting(Cells)
                        
300                     Call PriceThreshFormatting(ThreshCells, LowFormula, 65535, 3)
310                     Call PriceThreshFormatting(ThreshCells, HighFormula, 16776960, 4)
320                 Next
330                 Sheet15.Cells(1, 10) = 1
340             Next
            End If
350         Range("A14").Select
            
            
360         Call Module33.LogTime("RateFormatting", startTime, Now())
            
            Exit Sub
ErrorHandler:
370             Call Module33.LogEvent(Err, "Module29.RateFormatting", Erl)
380             Call Module33.ErrorHandler
         End Sub
         
         Sub PriceThreshFormatting(Cells As String, Formula As String, ColorLng As Long, CondIndex As Long)
            
            On Error GoTo ErrorHandler
            
            Dim startTime As Date
390         startTime = Now()
        If Cells > "" Then
400         Range(Cells).Select
410         Selection.FormatConditions.Add Type:=xlExpression, Formula1:=Formula
              '  "=AND(($O$7=TRUE),(($D$15-$D19) > IF(VLOOKUP($B19,RateFilters!$A$11:$E$100,2,0)=""--"",VLOOKUP($B19,RateFilters!$A$11:$E$100,3,0)*$D$15*0.01,VLOOKUP($B19,RateFilters!$A$11:$E$100,2,0))))"
            'Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
420         With Selection.FormatConditions(CondIndex).Interior
430             .PatternColorIndex = xlAutomatic
440             .Color = ColorLng
450             .TintAndShade = 0
            End With
460         Selection.FormatConditions(CondIndex).StopIfTrue = False
          End If
            
470         Call Module33.LogTime("PriceThreshFormatting", startTime, Now())
             Exit Sub
ErrorHandler:
480             Call Module33.LogEvent(Err, "Module29.PriceThreshFormatting", Erl)
490             Call Module33.ErrorHandler
        End Sub
         
        Sub ApplyHighLowFormatting(Cells As String)
           On Error GoTo ErrorHandler
            Dim startTime As Date
500         startTime = Now()
        If Cells > "" Then
510         Range(Cells).Select
520          Selection.FormatConditions.AddTop10
            ' Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
            
            ' Green
530         With Selection.FormatConditions(1)
540             .TopBottom = xlTop10Bottom
550             .Rank = 1
560             .Percent = False
            End With
570         With Selection.FormatConditions(1).Font
580             .Color = 5287936 '-11480942
590             .TintAndShade = 0
            End With
             ' Selection.FormatConditions(1).StopIfTrue = False
             
600         Selection.FormatConditions.AddTop10
610         With Selection.FormatConditions(2)
620             .TopBottom = xlTop10Top
630             .Rank = 1
640             .Percent = False
            End With
            ' Red
650         With Selection.FormatConditions(2).Font
660             .Color = -16776961
670             .TintAndShade = 0
            End With
            
680         Selection.FormatConditions(1).StopIfTrue = False
690         Selection.FormatConditions(2).StopIfTrue = False
            
            
            End If
700         Call Module33.LogTime("ApplyHighLowFormatting", startTime, Now())
            Exit Sub
ErrorHandler:
710             Call Module33.LogEvent(Err, "Module29.ApplyHighLowFormatting", Erl)
720             Call Module33.ErrorHandler
        End Sub
        
        Sub RatesUIThreshFormatting()
            On Error GoTo ErrorHandler
            Dim Formula As String
            Dim ColorLng As Long
            Dim CondIndex As Long
            Dim startTime As Date
730         startTime = Now()
            
            Dim LowFormula As String
            Dim HighFormula As String
            
            Dim prop As Integer
            Dim channels As Integer
            Dim days As Integer
            
740          channels = Sheet8.Cells(34, 3)
750         prop = Sheet8.Cells(33, 3)
760         days = Sheet8.Cells(32, 3)
            Dim Cells As String
            Dim isFilled As String
770         isFilled = Sheet23.Cells(1, 2)
           Dim isFormatted As String
780         isFormatted = Sheet23.Cells(1, 1)
            
790         If isFilled = "1" And isFormatted = "" Then
800             Sheet22.Activate
                Dim startRow As Long
                Dim subsRow As Long
                Dim startCol As Long
                Dim ThreshCells As String
810             startRow = 14
820             For lchn = 1 To channels Step 1
830                 Cells = ""
840                 startCol = 4
                    subsRow = startRow
850                 For lprop = 1 To prop + 1 Step 1
860                     Cells = Cells & "~" & startRow & ","
870                     startRow = startRow + 4
880                 Next
890                 Cells = left(Cells, Len(Cells) - 1)
900                 ThreshCells = Right(Cells, Len(Cells) - InStr(Cells, ","))
                    Dim PrevColName As String
                    Dim NewColName As String
910                 PrevColName = "~"
920                 For ldates = 1 To days Step 1
930                 HighFormula = "=AND($O$8=TRUE,RateUIDup!~" & (subsRow + 4) & "=1)"
940                 LowFormula = "=AND($O$7=TRUE,RateUIDup!~" & (subsRow + 4) & "=2)"
        '                LowFormula = "=AND(($O$7=TRUE),(($~$" & subsRow & "-$~" & (subsRow + 4) & " ) > IF(VLOOKUP($B" & (subsRow + 4) & " ,RateFilters!$B$11:$E$100,2,0)=""--"",VLOOKUP($B" & (subsRow + 4) & ",RateFilters!$B$11:$E$100,3,0)*$~$" & (subsRow) & " *0.01,VLOOKUP($B" & (subsRow + 4) & " ,RateFilters!$B$11:$E$100,2,0))))"
        '                HighFormula = "=AND(($O$8=TRUE),(($~" & (subsRow + 4) & "-$~$" & (subsRow) & " ) > IF(VLOOKUP($B" & (subsRow + 4) & " ,RateFilters!$B$11:$E$100,4,0)=""--"",VLOOKUP($B" & (subsRow + 4) & ",RateFilters!$B$11:$E$100,5,0)*$~$" & (subsRow) & " *0.01,VLOOKUP($B" & (subsRow + 4) & " ,RateFilters!$B$11:$E$100,4,0))))"
950                     NewColName = Module30.ColumnNameFromNo(startCol)
960                     Cells = Replace(Cells, PrevColName, NewColName)
970                     ThreshCells = Replace(ThreshCells, PrevColName, NewColName)
980                     LowFormula = Replace(LowFormula, "~", NewColName)
990                     HighFormula = Replace(HighFormula, "~", NewColName)
1000                        PrevColName = NewColName
1010                        startCol = startCol + 1
                        
1020                        Call PriceThreshFormatting(ThreshCells, LowFormula, 65535, 1)
1030                        Call PriceThreshFormatting(ThreshCells, HighFormula, 16776960, 2)
1040                    Next
1050                Next
                
1060                Sheet22.Calculate
                
1070                Sheet23.Cells(1, 1) = 1
1080                Sheet22.Cells(14, 4).Select
           End If
1090            Call Module33.LogTime("PriceThreshFormatting", startTime, Now())
             Exit Sub
ErrorHandler:
1100                Call Module33.LogEvent(Err, "Module29.RatesUIThreshFormatting", Erl)
1110                Call Module33.ErrorHandler
        End Sub
        
        Sub RatesUIThreshFormatting_old()
            On Error GoTo ErrorHandler
            Dim Formula As String
            Dim ColorLng As Long
            Dim CondIndex As Long
            Dim startTime As Date
1120            startTime = Now()
            
            Dim prop As Integer
            Dim channels As Integer
            Dim days As Integer
            
1130            channels = Sheet8.Cells(34, 3)
1140            prop = Sheet8.Cells(33, 3)
1150            days = Sheet8.Cells(32, 3)
                
           Dim isFormatted As String
1160            isFormatted = Sheet23.Cells(1, 1)
            
1170            If isFormatted = "" Then
                Dim r As Range
                Dim startC As Long
                
1180                Sheet22.Activate
                
1190                Set r = Sheet22.Cells(13, 4)
1200                r.Resize(r.Rows.Count + (prop * 4), (r.Columns.Count + days)).Select
            
                ' Low Threshhold
1210                Formula = "=AND($O$8=TRUE,RateUIDup!D13=1)"
1220                ColorLng = 65535
1230                CondIndex = 1
                
1240                Selection.FormatConditions.Add Type:=xlExpression, Formula1:=Formula
1250                With Selection.FormatConditions(CondIndex).Interior
1260                    .PatternColorIndex = xlAutomatic
1270                    .Color = ColorLng
1280                    .TintAndShade = 0
                End With
                
1290                Selection.FormatConditions(CondIndex).StopIfTrue = False
                
                ' High Threshhold
1300                Formula = "=AND($O$7=TRUE,RateUIDup!D13=2)"
1310                ColorLng = 16776960
1320                CondIndex = 2
1330                Selection.FormatConditions.Add Type:=xlExpression, Formula1:=Formula
1340                With Selection.FormatConditions(CondIndex).Interior
1350                    .PatternColorIndex = xlAutomatic
1360                    .Color = ColorLng
1370                    .TintAndShade = 0
                End With
                
1380                Selection.FormatConditions(CondIndex).StopIfTrue = False
                
1390                Sheet22.Calculate
                
1400                Sheet23.Cells(1, 1) = 1
           End If
1410            Call Module33.LogTime("PriceThreshFormatting", startTime, Now())
             Exit Sub
ErrorHandler:
1420                Call Module33.LogEvent(Err, "Module29.RatesUIThreshFormatting_old", Erl)
1430                Call Module33.ErrorHandler
        End Sub
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        'Sub RateFormatting()
        'Application.ScreenUpdating = False
        'Dim Formula As String
        'Formula = "=AND(($O$7=TRUE),(($D$15-$D19) > IF(VLOOKUP($B19,RateFilters!$A$11:$E$100,2,0)=""--"",VLOOKUP($B19,RateFilters!$A$11:$E$100,3,0)*$D$15*0.01,VLOOKUP($B19,RateFilters!$A$11:$E$100,2,0))))"
        '    Dim isFormatted As String
        '    isFormatted = Sheet15.Cells(1, 10)
        '
        '    If isFormatted = "" Then
        '        Dim prop As Integer
        '        Dim channels As Integer
        '        Dim days As Integer
        '
        '        channels = Sheet15.Cells(7, 1)
        '        prop = Sheet15.Cells(6, 1)
        '        days = Sheet15.Cells(3, 1)
        '
        '        Dim Cells As String
        '        ' Cells = "K15,K19,K23,K31,K27,K35"
        '
        '        Dim startRow As Long
        '        Dim startCol As Long
        '        startRow = 15
        '        For lchn = 1 To channels Step 1
        '            Cells = ""
        '            startCol = 4
        '            For lprop = 1 To prop Step 1
        '                Cells = Cells & "~" & startRow & ","
        '                startRow = startRow + 4
        '            Next
        '            Cells = Left(Cells, Len(Cells) - 1)
        '            Dim PrevColName As String
        '            Dim NewColName As String
        '            PrevColName = "~"
        '            For ldates = 1 To days Step 1
        '                NewColName = Module30.ColumnNameFromNo(startCol)
        '                Cells = Replace(Cells, PrevColName, NewColName)
        '                PrevColName = NewColName
        '                startCol = startCol + 1
        '
        '                Call ApplyHighLowFormatting(Cells)
        '                Call LowerPriceThreshFormatting(Cells, Formula)
        '            Next
        '            Sheet15.Cells(1, 10) = 1
        '        Next
        '    End If
        '    Application.ScreenUpdating = True
        ' End Sub
        '
        ' Sub LowerPriceThreshFormatting(Cells As String, Formula As String)
        ' Range("Cells").Select
        '    Selection.FormatConditions.Add Type:=xlExpression, Formula1:=Formula
        '      '  "=AND(($O$7=TRUE),(($D$15-$D19) > IF(VLOOKUP($B19,RateFilters!$A$11:$E$100,2,0)=""--"",VLOOKUP($B19,RateFilters!$A$11:$E$100,3,0)*$D$15*0.01,VLOOKUP($B19,RateFilters!$A$11:$E$100,2,0))))"
        '    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        '    With Selection.FormatConditions(1).Interior
        '        .PatternColorIndex = xlAutomatic
        '        .Color = 65535
        '        .TintAndShade = 0
        '    End With
        'End Sub
        '
        'Sub ApplyHighLowFormatting(Cells As String)
        '   Application.ScreenUpdating = False
        '    Range(Cells).Select
        '     Selection.FormatConditions.AddTop10
        '    ' Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        '
        '    ' Green
        '    With Selection.FormatConditions(1)
        '        .TopBottom = xlTop10Bottom
        '        .Rank = 1
        '        .Percent = False
        '    End With
        '    With Selection.FormatConditions(1).Font
        '        .Color = -11480942
        '        .TintAndShade = 0
        '    End With
        '
        '    Selection.FormatConditions.AddTop10
        '    With Selection.FormatConditions(2)
        '        .TopBottom = xlTop10Top
        '        .Rank = 1
        '        .Percent = False
        '    End With
        '    ' Red
        '    With Selection.FormatConditions(2).Font
        '        .Color = -16776961
        '        .TintAndShade = 0
        '    End With
        '
        '    ' Selection.FormatConditions(1).StopIfTrue = False
        '    Application.ScreenUpdating = True
        'End Sub


Attribute VB_Name = "Sheet4"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Worksheet_Activate()
    'Call Module31.UnFreezePane
End Sub
        
        Sub cb_Overvw_LOS_Change()
        On Error GoTo ErrorHandler
10          Call Module33.OptimizeCode_Begin
            Dim startTime As Date
20          startTime = Now()
        
30          If Sheet4.cb_Overvw_LOS.value <> "" Then
                
            Dim los As Integer
            Dim days As Integer
            Dim comps As Integer
            Dim SelectedIndex As Long
            
40          SelectedIndex = Sheet4.cb_Overvw_LOS.ListIndex + 1
50          los = Sheet4.cb_Overvw_LOS.value
60          days = Sheet8.Cells(50, 1)
70          comps = Sheet8.Cells(53, 1)
            
80          If los > 0 And days > 0 And comps > 0 Then
            Dim r As Range
            Dim startC As Long
            
90          startC = (days * (SelectedIndex - 1)) + 3
100         Set r = Sheet8.Cells(62, startC)
            
110         Sheet8.Visible = True
120         Sheet8.Activate
130         Sheet8.Select
140         r.Resize(comps * 3, (r.Columns.Count + days - 1)).Select
            
150         Application.CutCopyMode = False
           
160         Selection.Copy
170         Sheet8.Visible = False
            
180         Sheet4.Select
190         Sheet4.Range("C11").Select
200         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
210             Selection.PasteSpecial xlPasteFormats
220             Selection.PasteSpecial xlPasteColumnWidths
230             Selection.PasteSpecial xlPasteComments
                
240         Sheet4.Range("B9").Select
            
250         Application.CutCopyMode = False
            
260          Call Module23.Overview_CB_Channel_Click
270          Call Module23.Overview_CB_Diff_Click
              
            End If
            
             End If
280         Call Module33.LogTime("CB_Overvw_LOS_Change", startTime, Now())
290         Call Module33.OptimizeCode_End_ExceptCalculation
        Exit Sub
ErrorHandler:
300             Call Module33.LogEvent(Err, "Sheet4.cb_Overvw_LOS_Change", Erl)
310             Call Module33.ErrorHandler
        End Sub



Attribute VB_Name = "Module32"
        Public Sub RunInitialMacros()
        On Error GoTo ErrorHandler
        'MsgBox 1
            ' Application.EnableEvents = False
            'Call Module31.StopErrorRules
            'Call Module26.ClearFilter
10          Call Module33.OptimizeCode_Begin
            Dim startTime As Date
20          startTime = Now()
            
            'Call Module7.PivotManualUpdate(True)
610         Call Module40.GetAgeOfData

            
30          Call Module2.SetNamedListLOS
            
40          If ThisWorkbook.sheetExists("Sheet9") Then
50              Call ThisWorkbook.FillSupplyLOSCB
60              Call Module10.dd_Supply_LOS_Change
            End If
            
70          If ThisWorkbook.sheetExists("Sheet4") Then
80              Call ThisWorkbook.FillOverviewLOSCB
90              Call Module11.dd_Overvw_LOS_Change
            End If
            
100         If ThisWorkbook.sheetExists("Sheet12") Then
110             Call ThisWorkbook.FillParityLOSCB
120             Call Module6.dd_Parity_LOS_Change
            End If
            
            ' Set NamedList in case Rates/RatesUI sheet is present
130         If ThisWorkbook.sheetExists("Sheet5") Or ThisWorkbook.sheetExists("Sheet22") Then
140             Call Module2.SetNamedListRestriction
150             Call Module2.SetNamedListQualification
160             Call Module2.SetNamedListPromotion
170             Call Module2.SetNamedListProduct
180             Call Module2.SetNamedListInclusion
            End If
            
190          If ThisWorkbook.sheetExists("Sheet22") Then
200             Call Module29.RatesUIThreshFormatting
                Call Module26.FillRateUIFilters
             End If
             
220         If ThisWorkbook.sheetExists("Sheet5") Then
230            If Sheet5.Cells(1, 16).value = "" Then
240                  Call Module37.EmptyPivotCache(Sheet16.PivotTables("Pivot_Rate"))
250                  Call Module26.RefreshPivotTables
260                  Call Module29.RateFormatting
                End If
            
270             Call CallToFillRateFilters
                
280             If Sheet13.Cells(3, 1) <> "" And Sheet13.Cells(3, 1) <> "~~~~~~" And Sheet14.Cells(2, 1) = "" Then
                   ' MsgBox Sheet13.Cells(3, 1) + "p" + Sheet14.Cells(2, 1)
290                 Call Module25.Button_Rate_Filter(False)
                End If
300             Call Module36.SetRateControls
            End If
            
310         If ThisWorkbook.sheetExists("Sheet6") Then
320             If Sheet5.Cells(1, 16).value = "" Then
330                 Call Module37.EmptyPivotCache(Sheet3.PivotTables("Pivot_RSpread"))
340                  Call Module26.RefreshRateSpreadPivotTables
                End If
350             Call CallToFillRateSpreadFilters
360             Call Module36.SetRateSpreadControls
            End If
            ' Application.EnableEvents = True
            
            ' Fill Supply No of Guests
            'Dim val As String
            'val = Sheet1.Cells(6, 1)
            'If val > "" Then
            '    Sheet9.Cells(6, 2).Value = val
            'End If
            
            ' Update Checkbox for Overview
370         If ThisWorkbook.sheetExists("Sheet4") Then
380             Call Module23.Overview_CB_Channel_Click
390             Call Module23.Overview_CB_Diff_Click
            End If
            
            ' Update Checkbox for Rate
400         If ThisWorkbook.sheetExists("Sheet5") Then
410              Call Module13.cb_Rates_Diff_Click
420              Call Module13.cb_Rates_Desc_Click
430              Call Module13.cb_Rates_Age_Click
            End If
            
            ' Update Checkbox for RateUI
440         If ThisWorkbook.sheetExists("Sheet22") Then
450             Call Module38.cb_RatesUI_Desc_Click
460             Call Module38.cb_RatesUI_Age_Click
470             Call Module14.cb_RatesUI_Diff_Click
            End If
            
             ' Update Checkbox for RateSpread
480         If ThisWorkbook.sheetExists("Sheet6") Then
490             Call Module35.Chk_Ratespread_Click
            End If
            
            ' Update Checkbox for Parity
500         If ThisWorkbook.sheetExists("Sheet12") Then
510             Call Module7.Parity2_CheckBox1_Click
520             Call Module7.Parity2_Channel_Click
            End If
            
            ' Update Checkbox for Rank
530         If ThisWorkbook.sheetExists("Sheet10") Then
540             Call Module4.cb_Rank_OTA_Click
            End If
            
550         Call Module1.HideButtons
           
560         Call Module33.LogTime("RunInitialMacros", startTime, Now())
570         Call Module33.OptimizeCode_End
            
580         Sheet2.Activate
            Exit Sub
ErrorHandler:
590             Call Module33.LogEvent(Err, "Module32.RunInitialMacros")
600             Call Module33.ErrorHandler
        End Sub


Attribute VB_Name = "Module30"
      Function ColumnNameFromNo(ColNo As Long) As String
20           ColumnNameFromNo = Split(Cells(, ColNo).Address, "$")(1)
        End Function
        
      Function ColumnNoFromName(colName As String) As Long
40           ColumnNoFromName = Range(colName & 1).column
        End Function


Attribute VB_Name = "Sheet5"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Worksheet_Activate()
    'Call Module31.UnFreezePane
End Sub
        
        
        
        Private Sub CB_Rates_LOS_Change()
        On Error GoTo ErrorHandler
10          Call Module36.SetRateControls
                Exit Sub
ErrorHandler:
20              Call Module33.LogEvent(Err, "Sheet5.CB_Rates_LOS_Change", Erl)
30              Call Module33.ErrorHandler
        End Sub
        
        Private Sub CB_Rates_Product_Change()
        On Error GoTo ErrorHandler
40          Call Module36.SetRateControls
                Exit Sub
ErrorHandler:
50              Call Module33.LogEvent(Err, "Sheet5.CB_Rates_Product_Change", Erl)
60              Call Module33.ErrorHandler
        End Sub
        
        Private Sub CB_Rates_Promotion_Change()
        On Error GoTo ErrorHandler
70          Call Module36.SetRateControls
                Exit Sub
ErrorHandler:
80              Call Module33.LogEvent(Err, "Sheet5.CB_Rates_Promotion_Change", Erl)
90              Call Module33.ErrorHandler
        End Sub
        
        Private Sub CB_Rates_Qualification_Change()
        On Error GoTo ErrorHandler
100         Call Module36.SetRateControls
                Exit Sub
ErrorHandler:
110             Call Module33.LogEvent(Err, "Sheet5.CB_Rates_Qualification_Change", Erl)
120             Call Module33.ErrorHandler
        End Sub
        
        Private Sub CB_Rates_Restriction_Change()
        On Error GoTo ErrorHandler
130         Call Module36.SetRateControls
                Exit Sub
ErrorHandler:
140             Call Module33.LogEvent(Err, "Sheet5.CB_Rates_Restriction_Change", Erl)
150             Call Module33.ErrorHandler
        End Sub
        
        
        
        Sub chk_Rates_Age_Click()
        On Error GoTo ErrorHandler
160     Call Module33.OptimizeCode_Begin
        Dim startTime As Date
170     startTime = Now()
        
180         If ThisWorkbook.sheetExists("Sheet5") Then
            Dim comps As Integer
            Dim channels As Integer
            
190         channels = Sheet15.Cells(7, 1)
200         comps = Sheet15.Cells(6, 1)
        
210         cbChannel = Sheet5.chk_Rates_Age.value
220         Sheet5.Activate
230         For lCol = 0 To comps * channels * 4 Step 4
240             Set rCell = Range("C17").Offset(lCol, 0)
250             If cbChannel = False Then
260                 Rows(rCell.row).Hidden = True
270             ElseIf cbChannel = True Then
280                 Rows(rCell.row).Hidden = False
                End If
290         Next
300         Call CallToFillRateFilters
            
        End If
        
310     Call Module33.LogTime("chk_Rates_Age_Click", startTime, Now())
320     Call Module33.OptimizeCode_End_ExceptCalculation
            Exit Sub
ErrorHandler:
330             Call Module33.LogEvent(Err, "Sheet5.chk_Rates_Age_Click", Erl)
340             Call Module33.ErrorHandler
        End Sub
        
        Sub chk_Rates_Des_Click()
         On Error GoTo ErrorHandler
350         Call Module33.OptimizeCode_Begin
            Dim startTime As Date
360         startTime = Now()
            
370         If ThisWorkbook.sheetExists("Sheet5") Then
            Dim comps As Integer
            Dim channels As Integer
            
380         channels = Sheet15.Cells(7, 1)
390         comps = Sheet15.Cells(6, 1)
        
400         cbChannel = Sheet5.chk_Rates_Des.value
410         Sheet5.Activate
420         For lCol = 0 To comps * channels * 4 Step 4
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 663552 bytes
SHA-256: 8cbe245b67fc2365354dbc526434a7f98086876767cf39894e29cba91ffbbf87

Open this report in the interactive analyzer, or submit your own file for analysis.