Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 9d7d59a19e6e10df…

MALICIOUS

Office (OOXML)

246.6 KB Created: 2020-08-25 17:06:02 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2021-06-17
MD5: 9d38c1205275c2704f6157a7f3934be6 SHA-1: 0ecc01ce2a9b428b238f7e3450d60c86b4e658d4 SHA-256: 9d7d59a19e6e10dfeef0750a3e854d3907b336948305f65cac7c3065550bb882
334 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File T1140 Deobfuscate or Obfuscate T1059 Command and Scripting Interpreter

This OOXML document contains a Workbook_Open macro that utilizes WScript.Shell and CreateObject to execute arbitrary code. The macro likely attempts to download and execute a second-stage payload, as indicated by the presence of obfuscated VBA code and the 'Shell()' call. The document also impersonates a cloud file-sharing service, aiming to lure the user into enabling macros.

Heuristics 13

  • VBA project inside OOXML medium 6 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
        ' Run a shell command and return a status value
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        Set wshShell = CreateObject("Wscript.Shell")
    RunShellCommandLine = wshShell.Run(commandLine, _
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
            'map the Q: drive to the SharePoint site
        Set networkPath = CreateObject("WScript.Network")
        networkPath.MapNetworkDrive "Q:", L1
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Attribute VB_Customizable = True
Private Sub Workbook_Open()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
        Dim scriptFullFileName As String
    scriptFullFileName = Environ("Temp") & "\" & "Config"
  • External relationship high OOXML_EXTERNAL_REL
    External target in xl/externalLinks/_rels/externalLink1.xml.rels: file:///C:\Data\01 Work\29 Payroll Project\Files\Prototype -V1 - add Edwards2Channels.xlsm
  • Cloud document impersonation lure medium SE_CLOUD_DOC_LURE
    Document impersonates a cloud file-sharing service such as SharePoint, OneDrive, Google Drive, Dropbox, Box, or Microsoft 365 and asks the user to open, verify, or access a shared document
  • Suspicious extracted artifact medium EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • External hyperlinks (19) low OOXML_EXTERNAL_HYPERLINKS
    Document contains 19 external hyperlinks — clickable URLs are stored as external relationships. First target: https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG7/Shared Documents/Edwards PG 7
  • Hidden worksheet (hidden) low OOXML_HIDDEN_SHEET
    Excel workbook contains 11 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://docs.google.com/spreadsheets/d/e/2PACX-1vQXt8FJxvsvO1aZADI1MKJfUcLtJAFZO7c-XKIc6j9JCizV8a7yborS3AaasiLLBA/pubhtml Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG1/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/EmployeeMasterFiles/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/PayRunPreparation/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG2/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG4/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG6/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG7/SharedDocument hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG8/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-Mafi-TrenchPG1/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-Mafi-TrenchPG2/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG3/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG1/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG2/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG3/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG4/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG5/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG5/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG6/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG72/SharedOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG7/Shared Documents/Edwards PG 7Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG5/Shared Documents/Compressor PG 5Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/EmployeeMasterFiles-MasterFiles/Shared Documents/Master FilesDocument hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG2/Shared Documents/Edwards PG 2Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG6/Shared Documents/Edwards PG 6Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG4/Shared Documents/Compressor PG 4Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-Mafi-TrenchPG2/Shared Documents/Mafi-Trench PG2Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG1/Shared Documents/Edwards PG 1Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-Mafi-TrenchPG1/Shared Documents/Mafi-Trench PG1Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG3/Shared Documents/Compressor PG 3Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG5/Shared Documents/Edwards PG 5Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG2/Shared Documents/Compressor PG 2Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG4/Shared Documents/Edwards PG 4Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG72/Shared Documents/Compressor PG 7Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG1/Shared Documents/Compressor PG 1Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/PayRunPreparation/Shared Documents/Master DataDocument hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG3/Shared Documents/Edwards PG 3Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-EdwardsPG8/Shared Documents/Edwards PG 8Document hyperlink
    • https://onevirtualoffice.sharepoint.com/sites/ACNAPayroll-CompressorPG6/Shared Documents/Compressor PG 6Document hyperlink
    • https://support.microsoft.com/en-us/help/2745652/object-model-calls-may-fail-from-workbookopen-event-when-exiting-proteOOXML external relationship
    • https://onevirtualoffice.sharepoint.com/sites/PayRunPreparation/Shared%20Documents/Temp%20Folder/OOXML external relationship

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) 97485 bytes
SHA-256: 43f7f93573c1562126dc0589e8900e008e6435821cb1fd92fc3ffdd18c5ba888
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 1 eval/decoder/string-building token(s).
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "Sheet1"
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 OptionButton3_Click()


'    Dim rng As Range
'    Set rng = ActiveSheet.Range("C9")
'    With ActiveSheet.OLEObjects("CheckBox3")
'        .Top = rng.Top
'        .Left = rng.Left
'        .Width = rng.Width
'        .Height = rng.RowHeight
'        .Visible = True
'    End With
'
'    ThisWorkbook.Worksheets("Ctrl").CheckBox1.Value = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox2.Value = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox3.Value = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox5.Value = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox6.Value = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox7.Value = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox8.Value = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox9.Value = False
    
'    ThisWorkbook.Worksheets("Ctrl").CheckBox1.Visible = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox2.Visible = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox5.Visible = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox6.Visible = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox7.Visible = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox8.Visible = False
'    ThisWorkbook.Worksheets("Ctrl").CheckBox9.Visible = False
    
    '---------------------------------------------------------
    
    'AC Compressors has 5 channels
    
    ThisWorkbook.Worksheets("Ctrl").CheckBox1.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox2.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox3.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox5.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox6.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox7.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox8.Value = False

    
    
    Dim rng1 As Range
    Set rng1 = ActiveSheet.Range("C9")
    With ActiveSheet.OLEObjects("CheckBox1")
        .Top = rng1.Top
        .Left = rng1.Left
        .Width = rng1.Width
        .Height = rng1.RowHeight
        .Visible = True
    End With

    Dim rng2 As Range
    Set rng2 = ActiveSheet.Range("C11")
    With ActiveSheet.OLEObjects("CheckBox2")
        .Top = rng2.Top
        .Left = rng2.Left
        .Width = rng2.Width
        .Height = rng2.RowHeight
        .Visible = True
    End With
    
    Dim rng3 As Range
    Set rng3 = ActiveSheet.Range("C13")
    With ActiveSheet.OLEObjects("CheckBox3")
        .Top = rng3.Top
        .Left = rng3.Left
        .Width = rng3.Width
        .Height = rng3.RowHeight
        .Visible = True
    End With
  
    
    Dim rng5 As Range
    Set rng5 = ActiveSheet.Range("C15")
    With ActiveSheet.OLEObjects("CheckBox5")
        .Top = rng5.Top
        .Left = rng5.Left
        .Width = rng5.Width
        .Height = rng5.RowHeight
        .Visible = True
    End With
    
    Dim rng6 As Range
    Set rng6 = ActiveSheet.Range("C17")
    With ActiveSheet.OLEObjects("CheckBox6")
        .Top = rng6.Top
        .Left = rng6.Left
        .Width = rng6.Width
        .Height = rng6.RowHeight
        .Visible = True
    End With
    
    Dim rng7 As Range
    Set rng7 = ActiveSheet.Range("C19")
    With ActiveSheet.OLEObjects("CheckBox7")
        .Top = rng7.Top
        .Left = rng7.Left
        .Width = rng7.Width
        .Height = rng7.RowHeight
        .Visible = True
    End With

    Dim rng8 As Range
    Set rng8 = ActiveSheet.Range("C21")
    With ActiveSheet.OLEObjects("CheckBox8")
        .Top = rng8.Top
        .Left = rng8.Left
        .Width = rng8.Width
        .Height = rng8.RowHeight
        .Visible = True
    End With
    
    
    
    ThisWorkbook.Worksheets("Ctrl").CheckBox9.Visible = False
        

End Sub

Private Sub OptionButton7_Click()
    
    ThisWorkbook.Worksheets("Ctrl").CheckBox1.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox2.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox3.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox5.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox6.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox7.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox8.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox9.Value = False
    

    Dim rng1 As Range
    Set rng1 = ActiveSheet.Range("C9")
    With ActiveSheet.OLEObjects("CheckBox1")
        .Top = rng1.Top
        .Left = rng1.Left
        .Width = rng1.Width
        .Height = rng1.RowHeight
        .Visible = True
    End With

    Dim rng2 As Range
    Set rng2 = ActiveSheet.Range("C11")
    With ActiveSheet.OLEObjects("CheckBox2")
        .Top = rng2.Top
        .Left = rng2.Left
        .Width = rng2.Width
        .Height = rng2.RowHeight
        .Visible = True
    End With
    
    Dim rng3 As Range
    Set rng3 = ActiveSheet.Range("C13")
    With ActiveSheet.OLEObjects("CheckBox3")
        .Top = rng3.Top
        .Left = rng3.Left
        .Width = rng3.Width
        .Height = rng3.RowHeight
        .Visible = True
    End With
  
    
    Dim rng5 As Range
    Set rng5 = ActiveSheet.Range("C15")
    With ActiveSheet.OLEObjects("CheckBox5")
        .Top = rng5.Top
        .Left = rng5.Left
        .Width = rng5.Width
        .Height = rng5.RowHeight
        .Visible = True
    End With

    Dim rng6 As Range
    Set rng6 = ActiveSheet.Range("C17")
    With ActiveSheet.OLEObjects("CheckBox6")
        .Top = rng6.Top
        .Left = rng6.Left
        .Width = rng6.Width
        .Height = rng6.RowHeight
        .Visible = True
    End With
    
    Dim rng7 As Range
    Set rng7 = ActiveSheet.Range("C19")
    With ActiveSheet.OLEObjects("CheckBox7")
        .Top = rng7.Top
        .Left = rng7.Left
        .Width = rng7.Width
        .Height = rng7.RowHeight
        .Visible = True
    End With

    Dim rng8 As Range
    Set rng8 = ActiveSheet.Range("C21")
    With ActiveSheet.OLEObjects("CheckBox8")
        .Top = rng8.Top
        .Left = rng8.Left
        .Width = rng8.Width
        .Height = rng8.RowHeight
        .Visible = True
    End With
    
    Dim rng9 As Range
    Set rng9 = ActiveSheet.Range("C23")
    With ActiveSheet.OLEObjects("CheckBox9")
        .Top = rng9.Top
        .Left = rng9.Left
        .Width = rng9.Width
        .Height = rng9.RowHeight
        .Visible = True
    End With
    
    

End Sub

Private Sub OptionButton8_Click()

    ThisWorkbook.Worksheets("Ctrl").CheckBox1.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox2.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox3.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox5.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox6.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox7.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox8.Value = False
    ThisWorkbook.Worksheets("Ctrl").CheckBox9.Value = False
    

    Dim rng1 As Range
    Set rng1 = ActiveSheet.Range("C9")
    With ActiveSheet.OLEObjects("CheckBox1")
        .Top = rng1.Top
        .Left = rng1.Left
        .Width = rng1.Width
        .Height = rng1.RowHeight
        .Visible = True
    End With

    Dim rng2 As Range
    Set rng2 = ActiveSheet.Range("C11")
    With ActiveSheet.OLEObjects("CheckBox2")
        .Top = rng2.Top
        .Left = rng2.Left
        .Width = rng2.Width
        .Height = rng2.RowHeight
        .Visible = True
    End With
    
    Dim rng3 As Range
    Set rng3 = ActiveSheet.Range("C13")
    With ActiveSheet.OLEObjects("CheckBox3")
        .Top = rng3.Top
        .Left = rng3.Left
        .Width = rng3.Width
        .Height = rng3.RowHeight
        .Visible = False
    End With
  
    
    Dim rng5 As Range
    Set rng5 = ActiveSheet.Range("C15")
    With ActiveSheet.OLEObjects("CheckBox5")
        .Top = rng5.Top
        .Left = rng5.Left
        .Width = rng5.Width
        .Height = rng5.RowHeight
        .Visible = False
    End With

    Dim rng6 As Range
    Set rng6 = ActiveSheet.Range("C17")
    With ActiveSheet.OLEObjects("CheckBox6")
        .Top = rng6.Top
        .Left = rng6.Left
        .Width = rng6.Width
        .Height = rng6.RowHeight
        .Visible = False
    End With
    
    Dim rng7 As Range
    Set rng7 = ActiveSheet.Range("C19")
    With ActiveSheet.OLEObjects("CheckBox7")
        .Top = rng7.Top
        .Left = rng7.Left
        .Width = rng7.Width
        .Height = rng7.RowHeight
        .Visible = False
    End With

    Dim rng8 As Range
    Set rng8 = ActiveSheet.Range("C21")
    With ActiveSheet.OLEObjects("CheckBox8")
        .Top = rng8.Top
        .Left = rng8.Left
        .Width = rng8.Width
        .Height = rng8.RowHeight
        .Visible = False
    End With
    
    Dim rng9 As Range
    Set rng9 = ActiveSheet.Range("C23")
    With ActiveSheet.OLEObjects("CheckBox9")
        .Top = rng9.Top
        .Left = rng9.Left
        .Width = rng9.Width
        .Height = rng9.RowHeight
        .Visible = False
    End With



End Sub

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
Private Sub Workbook_Open()

 On Error GoTo AnyError
        
        VBConfig
        Connect
        
        ThisWorkbook.Worksheets("Employees").UsedRange.ClearContents
                    
        
        Exit Sub
    '   --------
    
AnyError:
        MsgBox "Macro failed to complete." & vbNewLine & vbNewLine & Err.Description

End Sub

Attribute VB_Name = "DownloadCheck"
Sub DownloadFileFromWeb()

Dim OutputFile As Workbook
Dim ws As Worksheet
Dim wb As Workbook
Dim networkPath As Object
Dim fileName As String
Dim val As Integer
Dim val2 As Integer
Dim CompId As String
Dim wsCtrl As Worksheet


On Error GoTo AnyError
    
' Start recording summary data, including elapsed time
CallScript "SummaryData_Initialize"

Set wb = ThisWorkbook
Set wsCtrl = wb.Worksheets("Ctrl")
Set wsData = wb.Worksheets("Data")

'Check Comp ID

If ThisWorkbook.Worksheets("Ctrl").OptionButton3.Value = True Then
    CompId = ThisWorkbook.Worksheets("Ctrl").OptionButton3.Caption  'AC Compressors
    EmployeeMasterCOMPID = "ATLASCOI"
ElseIf ThisWorkbook.Worksheets("Ctrl").OptionButton7.Value = True Then
    CompId = ThisWorkbook.Worksheets("Ctrl").OptionButton7.Caption  'Edwards
    EmployeeMasterCOMPID = "ATLASEDW"
ElseIf ThisWorkbook.Worksheets("Ctrl").OptionButton8.Value = True Then
    CompId = ThisWorkbook.Worksheets("Ctrl").OptionButton8.Caption  'Mafi-Trench
    EmployeeMasterCOMPID = "ATLASCOR"
End If


If ThisWorkbook.Worksheets("Ctrl").CheckBox1.Value = False And ThisWorkbook.Worksheets("Ctrl").CheckBox2.Value = False And ThisWorkbook.Worksheets("Ctrl").CheckBox3.Value = False And ThisWorkbook.Worksheets("Ctrl").CheckBox5.Value = False And ThisWorkbook.Worksheets("Ctrl").CheckBox6.Value = False And ThisWorkbook.Worksheets("Ctrl").CheckBox7.Value = False And ThisWorkbook.Worksheets("Ctrl").CheckBox8.Value = False And ThisWorkbook.Worksheets("Ctrl").CheckBox9.Value = False Then
    MsgBox "Please select one Channel/PayGroup!", vbInformation
    GoTo Ende
End If

If ThisWorkbook.Worksheets("Ctrl").CheckBox1.Value = True Then
    Ch1 = 1
Else
    Ch1 = "No"
End If

If ThisWorkbook.Worksheets("Ctrl").CheckBox2.Value = True Then
    Ch2 = 2
Else
    Ch2 = "No"
End If

If ThisWorkbook.Worksheets("Ctrl").CheckBox3.Value = True Then
    Ch3 = 3
Else
    Ch3 = "No"
End If

If ThisWorkbook.Worksheets("Ctrl").CheckBox5.Value = True Then
    Ch4 = 4
Else
    Ch4 = "No"
End If

If ThisWorkbook.Worksheets("Ctrl").CheckBox6.Value = True Then
    Ch5 = 5
Else
    Ch5 = "No"
End If

If ThisWorkbook.Worksheets("Ctrl").CheckBox7.Value = True Then
    Ch6 = 6
Else
    Ch6 = "No"
End If

If ThisWorkbook.Worksheets("Ctrl").CheckBox8.Value = True Then
    Ch7 = 7
Else
    Ch7 = "No"
End If

If ThisWorkbook.Worksheets("Ctrl").CheckBox9.Value = True Then
    Ch8 = 8
Else
    Ch8 = "No"
End If



'check file properties like : have have Last Name and First Name check
Set wsParam = wb.Worksheets("Param")
LastRowParam = wsParam.Cells(Rows.Count, "A").End(xlUp).Row

HeaderColumn = ""
'LastFirstNameCheck = ""

For c = 2 To LastRowParam
    If wsParam.Range("A" & c) = CompId Then
        Code = wsParam.Range("B" & c).Value
        'HeaderColumn = wsParam.Range("C" & c).Value
        'LastFirstNameCheck = wsParam.Range("D" & c).Value
        AmountTypeCheck = wsParam.Range("E" & c).Value
        
        
    End If

Next c


'Clear Data
Worksheets("Data").Cells.Clear

'Map network drive and get data from teams
LastRow3 = wb.Worksheets("Ctrl").Cells(Rows.Count, "BA").End(xlUp).Row
For o = 2 To LastRow3
    If wsCtrl.Range("BB" & o) = CompId And (wsCtrl.Range("BC" & o) = Ch1 Or wsCtrl.Range("BC" & o) = Ch2 Or wsCtrl.Range("BC" & o) = Ch3 Or wsCtrl.Range("BC" & o) = Ch4 Or wsCtrl.Range("BC" & o) = Ch5 Or wsCtrl.Range("BC" & o) = Ch6 Or wsCtrl.Range("BC" & o) = Ch7 Or wsCtrl.Range("BC" & o) = Ch8) Then

        L1 = ThisWorkbook.Worksheets("Ctrl").Range("BA" & o)
        
        'Clear Data sheet
        Worksheets("Ctrl").Columns("AZ:AZ").Cells.Clear
        
        ' Validate if the drive exist, if exist then change drive to another one
        
        'map the Q: drive to the SharePoint site
        Set networkPath = CreateObject("WScript.Network")
        networkPath.MapNetworkDrive "Q:", L1
        fileName = Dir("Q:\*.*")
        
        
        f = 2
        Do While fileName <> ""
            f = f + 1
            ThisWorkbook.Worksheets("Ctrl").Range("AZ" & f) = fileName
            fileName = Dir()
            
        Loop
        
        'all done, clean up time
        networkPath.RemoveNetworkDrive "Q:"
        Set networkDrive = Nothing
        
        
        
        LastRow = wb.Worksheets("Ctrl").Cells(Rows.Count, "AZ").End(xlUp).Row
        
        
        For i = 3 To LastRow
        
        LastRow2 = wb.Worksheets("Data").Cells(Rows.Count, "B").End(xlUp).Row
               
        If LastRow2 <> 1 Then
        LastRow2 = LastRow2 + 1
        End If
        
        ' Setup "Checkout" status the files on all channel in sharepoint
        If Workbooks.CanCheckOut(L1 & "/" & ThisWorkbook.Worksheets("Ctrl").Range("AZ" & i)) Then
            Workbooks.CheckOut L1 & "/" & ThisWorkbook.Worksheets("Ctrl").Range("AZ" & i)
            Application.DisplayAlerts = False
        End If
        Application.DisplayAlerts = False
        
        
        'copy file data
         Set OutputFile = Workbooks.Open(L1 & "/" & ThisWorkbook.Worksheets("Ctrl").Range("AZ" & i))
             
            Openfile = ActiveWorkbook.Name
            Set ws = ActiveSheet
            
            fileName = ThisWorkbook.Name
            
            Workbooks(Openfile).Activate
            Set ws = ActiveSheet
           
            ws.Range("A1").Select
        
            LastRowOutputFile = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
            LastColumnOutputFile = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            
            'Check HeaderColumn
            If Trim(CStr(ws.Cells(2, 6))) <> "" Then
                HeaderColumn = "Yes"
                
                
                     ws.Range(ws.Cells(1, 1), ws.Cells(LastRowOutputFile + 1, LastColumnOutputFile)).Copy
                     Windows(fileName).Activate
                     ThisWorkbook.Sheets("Data").Activate
                     ActiveSheet.Range("A" & LastRow2).Select
                     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                     ActiveSheet.Range("A1").Select
                     Windows(Openfile).Application.CutCopyMode = False
                     Windows(Openfile).Close SaveChanges:=False
                    
              
            Else

                
                HeaderColumn = "No"
               
               ' Edwards file
        
                ws.Range("A1:A" & LastRowOutputFile).Copy wsData.Range("C" & LastRow2) 'CompID
                ws.Range("B1:B" & LastRowOutputFile).Copy wsData.Range("B" & LastRow2)  'ProdID
                ws.Range("C1:C" & LastRowOutputFile).Copy wsData.Range("G" & LastRow2)  'Check#
                ws.Range("D1:D" & LastRowOutputFile).Copy wsData.Range("L" & LastRow2)  'Date
                ws.Range("E1:E" & LastRowOutputFile).Copy wsData.Range("H" & LastRow2)  'Paygroup
                ws.Range("F1:F" & LastRowOutputFile).Copy wsData.Range("F" & LastRow2)  'Amt Type
                ws.Range("H1:H" & LastRowOutputFile).Copy wsData.Range("D" & LastRow2)  'E/D-CODE
                ws.Range("I1:I" & LastRowOutputFile).Copy wsData.Range("E" & LastRow2)  'AMOUNT
                ws.Range("O1:O" & LastRowOutputFile).Copy wsData.Range("M" & LastRow2)  'Date2
                 
                Windows(Openfile).Application.CutCopyMode = False
                Windows(Openfile).Close SaveChanges:=False
                    
            End If
           
        
        If LastRow2 <> 1 And HeaderColumn = "Yes" Then
        Worksheets("Data").Rows(LastRow2 & ":" & LastRow2).Select
        Selection.Delete Shift:=xlUp
        End If
        
        
                
        Next i
        
        'Clear Worksheet names
        'ThisWorkbook.Worksheets("Ctrl").Columns("AZ:AZ").Cells.Clear

    End If

Next o


'Check Again HeaderColumn after combine
If Trim(CStr(wsData.Cells(2, 6))) = "" Then
   HeaderColumn = "No"
Else
    HeaderColumn = "Yes"
End If
            


'start Check for combined sheet

If HeaderColumn = "No" Then
    wsData.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      
End If

'change headers
  wsData.Range("A1") = "COMPID"
  wsData.Range("B1") = "PRO ID"
  wsData.Range("C1") = "CODE TYPE"
  wsData.Range("D1") = "E/D-CODE"
  wsData.Range("E1") = "AMOUNT"
  wsData.Range("F1") = "AMT TYPE"
  wsData.Range("G1") = "CHECK #"
  wsData.Range("H1") = "PAY GROUP"
  wsData.Range("N1") = "LAST NAME"
  wsData.Range("O1") = "FIRST NAME"
  
    'add headers for lookup
  If wsData.Range("I1") = "" Then wsData.Range("I1") = "*"
  If wsData.Range("J1") = "" Then wsData.Range("J1") = "*"
  If wsData.Range("K1") = "" Then wsData.Range("K1") = "*"
  If wsData.Range("L1") = "" Then wsData.Range("L1") = "*"
  If wsData.Range("M1") = "" Then wsData.Range("M1") = "*"
  
  If wsData.Range("P1") = "" Then wsData.Range("P1") = "*"
  If wsData.Range("Q1") = "" Then wsData.Range("Q1") = "*"
  If wsData.Range("R1") = "" Then wsData.Range("R1") = "*"
  If wsData.Range("U1") = "" Then wsData.Range("U1") = "*"
  If wsData.Range("X1") = "" Then wsData.Range("X1") = "*"
  If wsData.Range("Y1") = "" Then wsData.Range("Y1") = "*"
   
  
  wsData.Range("S1") = "VEMPID"
  wsData.Range("T1") = "VTERMDATE"
  wsData.Range("V1") = "CONNAME"
  wsData.Range("W1") = "VNAME"
  wsData.Range("Z1") = "SUBPAY"




LastRow = wb.Worksheets("Data").Cells(Rows.Count, "B").End(xlUp).Row
    
'Format B(EMPID) to number

'    With ThisWorkbook.Worksheets("Data").Range("B2:B" & LastRow)
'        .NumberFormat = "General"
'        .Value = .Value
'    End With
    
'Format D(E/D-CODE) & E(AMOUNT) to number

    With ThisWorkbook.Worksheets("Data").Range("D2:E" & LastRow)
        .NumberFormat = "General"
        .Value = .Value
    End With
    
    
''set correct amount type
'If ThisWorkbook.Worksheets("Ctrl").OptionButton1.Value = True Then
'    Typ = "$"
'    Typ2 = "H"
'ElseIf ThisWorkbook.Worksheets("Ctrl").OptionButton2.Value = True Then
'    Typ = "H"
'    Typ2 = "$"
'End If

If ThisWorkbook.Worksheets("Ctrl").OptionButton3.Value = True Then
    Code = 105
End If



'Vlookup data

Call UnlockEmployeeMasterSheet

LastRowEmployees = wb.Worksheets("Employees").Cells(Rows.Count, "A").End(xlUp).Row

ThisWorkbook.Worksheets("Employees").Range("T2") = "=A2"
ThisWorkbook.Worksheets("Employees").Range("U2") = "=TEXT(C2," & Chr(34) & "00000000" & Chr(34) & ")"   'EmpID IN TEXT FORMAT(8chars)
ThisWorkbook.Worksheets("Employees").Range("V2") = "=CONCATENATE(TRIM(J2),TRIM(U2))"   'EmpID & COMPID
ThisWorkbook.Worksheets("Employees").Range("K2:W2").Copy ThisWorkbook.Worksheets("Employees").Range("K3:W" & LastRowEmployees)
Application.CutCopyMode = False


ThisWorkbook.Worksheets("Data").Range("AD2") = EmployeeMasterCOMPID
ThisWorkbook.Worksheets("Data").Range("AA2") = "=CONCATENATE(TRIM(AD2),TEXT(B2,""00000000""))"   'EmpID & COMPID

'ThisWorkbook.Worksheets("Data").Range("AA2") = "=TEXT(B2," & Chr(34) & "00000000" & Chr(34) & ")"   'EmpID IN TEXT FORMAT(7chars)
ThisWorkbook.Worksheets("Data").Range("S2") = "=IFERROR(INDEX(Employees!$A$2:$V$" & LastRowEmployees & ",MATCH(Data!AA2,Employees!$V$2:$V$" & LastRowEmployees & ",0),3)," & Chr(34) & Chr(34) & ")" 'EmpID
ThisWorkbook.Worksheets("Data").Range("T2") = "=IFERROR(INDEX(Employees!$A$2:$V$" & LastRowEmployees & ",MATCH(Data!AA2,Employees!$V$2:$V$" & LastRowEmployees & ",0),8)," & Chr(34) & Chr(34) & ")" 'TERMDATE
ThisWorkbook.Worksheets("Data").Range("U2") = "=IFERROR(INDEX(Employees!$A$2:$V$" & LastRowEmployees & ",MATCH(Data!AA2,Employees!$V$2:$V$" & LastRowEmployees & ",0),6)," & Chr(34) & Chr(34) & ")" 'SAL_HR
ThisWorkbook.Worksheets("Data").Range("Z2") = "=IFERROR(INDEX(Employees!$A$2:$V$" & LastRowEmployees & ",MATCH(Data!AA2,Employees!$V$2:$V$" & LastRowEmployees & ",0),7)," & Chr(34) & Chr(34) & ")" 'OTEXEMPT


ThisWorkbook.Worksheets("Data").Range("R2:AD2").Copy ThisWorkbook.Worksheets("Data").Range("R3:AD" & LastRow)
Application.CutCopyMode = False



For i = 2 To LastRow

Call UnlockResultCells

'clear sheets
Worksheets("Calc").Cells.Clear
Worksheets("Result").Cells.Clear



'check if empid is only numeric
If IsNumeric(ThisWorkbook.Worksheets("Data").Range("B" & i)) = False Then
    f = f + 1
    wb.Worksheets("Result").Range("A" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") doesn't only contain Numbers"
End If


''Check if empid is existing
'
'
'If ThisWorkbook.Worksheets("Data").Range("S" & i) = "" Then
'    f = f + 1
'    wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") doesn't exist in ProBusiness"
'    wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
'End If

''check if first and last name match on the employee sheet with the upload file. If not it has to be an error
'If LastFirstNameCheck = "Yes" Then
'
'    If ThisWorkbook.Worksheets("Data").Range("W" & i).Value = 0 Then
'    f = f + 1
'    wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") and code: " & ThisWorkbook.Worksheets("Data").Range("D" & i) & " doesn't match first name and last name in ProBusiness"
'    wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
'
'    End If
'End If


'Check if emp is terminated

If ThisWorkbook.Worksheets("Data").Range("T" & i) <> 0 And ThisWorkbook.Worksheets("Data").Range("T" & i) <> "" Then
    f = f + 1
    wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") is terminated"
    wb.Worksheets("Result").Range("A" & 1 + f) = "N"

End If


'check if empid is only numeric

If IsNumeric(ThisWorkbook.Worksheets("Data").Range("B" & i)) = False Then
    f = f + 1
    wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") doesn't only contain Numbers"
    wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
    
End If


'Check if Commission file has H in AMT Type (Error if the typ is not "$") -- or Time file has $ in AMT Type (Error if the typ is not "H") -- skip for Edwards
'
'If ThisWorkbook.Worksheets("Data").Range("F" & i) = Typ Then
'
'f = f + 1
'    If ThisWorkbook.Worksheets("Ctrl").OptionButton1.Value = True Then
'        wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has $ as value in AMT Type"
'
'    ElseIf ThisWorkbook.Worksheets("Ctrl").OptionButton2.Value = True Then
'        wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has H as value in AMT Type"
'
'    End If
'    wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
'
'End If


''check if COMPID is blank
'If CompIdOnFile = "Yes" Then
'    If CStr(ThisWorkbook.Worksheets("Data").Range("A" & i)) = "" Then
'        f = f + 1
'            wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has blank COMPID"
'            wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
'    End If
'End If

'check if PRO ID is blank

If CStr(ThisWorkbook.Worksheets("Data").Range("B" & i)) = "" Then
        f = f + 1
        wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has blank PRO ID"
        wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
    
End If

'' check if S type is other than 135, 140, or 130
'If (ThisWorkbook.Worksheets("Data").Range("F" & i) = "S" And CStr(ThisWorkbook.Worksheets("Data").Range("D" & i)) <> "135" And CStr(ThisWorkbook.Worksheets("Data").Range("D" & i)) <> "140" And ThisWorkbook.Worksheets("Data").Range("D" & i) <> "130") Then
'    f = f + 1
'    wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has a non valid code " & ThisWorkbook.Worksheets("Data").Range("D" & i)
'    wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
'End If


' code 380, or 381 give an error message that says: "Please send severance agreement to payroll and remove these entries from upload file"
If CStr(ThisWorkbook.Worksheets("Data").Range("D" & i)) = "380" Or ThisWorkbook.Worksheets("Data").Range("D" & i) = 380 Or CStr(ThisWorkbook.Worksheets("Data").Range("D" & i)) = "381" Or ThisWorkbook.Worksheets("Data").Range("D" & i) = 381 Then
    f = f + 1
    wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has code 380/381. Please send severance agreement to payroll and remove these entries from upload file"
    wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
End If


'check if commission button is checked --NO NEED TO CHECK ON DOWNLOAD AND COMBINE FILE

'If ThisWorkbook.Worksheets("Ctrl").OptionButton2.Value = True Then
'
'
'    'check if the commission amount is below 0 for a term employee, error "EmployeeID has commission amount below 0 for a term employee. Please remove these entries from upload file"
'
'    If (ThisWorkbook.Worksheets("Data").Range("T" & i) <> 0 And ThisWorkbook.Worksheets("Data").Range("T" & i) <> "") And (ThisWorkbook.Worksheets("Data").Range("E" & i) < 0 And CStr(ThisWorkbook.Worksheets("Data").Range("E" & i)) <> "") Then
'        f = f + 1
'        wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has Commission amount below 0 for a term employee. Please remove these entries from upload file"
'        wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
'    End If
'
'
'    'check if amount under 0, Check# should be 1 (error if it is not 1)
'    If (ThisWorkbook.Worksheets("Data").Range("E" & i) <= 0 And CStr(ThisWorkbook.Worksheets("Data").Range("E" & i)) <> "") And ThisWorkbook.Worksheets("Data").Range("G" & i) <> 1 Then
'        f = f + 1
'        wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has Commission Amount less than 0 and check# is not 1"
'        wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
'    End If
'
'    'check if amount above 0, Check# should not be 1 (error if it is 1)
'    If (ThisWorkbook.Worksheets("Data").Range("E" & i) > 0 And CStr(ThisWorkbook.Worksheets("Data").Range("E" & i)) <> "") And ThisWorkbook.Worksheets("Data").Range("G" & i) = 1 Then
'        f = f + 1
'        wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has Commission Amount above than 0 and check# is 1"
'        wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
'    End If
'
'     'check if amount commission is blank
'    If CStr(ThisWorkbook.Worksheets("Data").Range("E" & i)) = "" Then
'        f = f + 1
'        wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has blank Commission Amount"
'        wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
'    End If
'
'    ' Error if the code is not 300
'    If CStr(ThisWorkbook.Worksheets("Data").Range("D" & i)) <> "300" Or ThisWorkbook.Worksheets("Data").Range("D" & i) <> 300 Then
'        f = f + 1
'        wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has code not 300"
'        wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
'    End If
'
'     ' Error if the typ is not "$"
'    If CStr(ThisWorkbook.Worksheets("Data").Range("F" & i)) <> "$" Then
'        f = f + 1
'        wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Data").Range("B" & i) & "(" & ThisWorkbook.Worksheets("Data").Range("O" & i) & " " & ThisWorkbook.Worksheets("Data").Range("N" & i) & ") has H as value in AMT Type"
'        wb.Worksheets("Result").Range("A" & 1 + f) = "Y"
'    End If
'
'
'End If


   
Next i


'Create pivot on sheet Data
'---------------------------
Dim PC  As Excel.PivotCache
Dim PT  As Excel.PivotTable
Dim pvtFld As Excel.PivotField
Dim SrcData As Range
Dim DataSht As Worksheet
Dim StartPvt As String
Dim LastRowData As Long, LastColumnData As Long

Set ws = wb.Worksheets("Calc")

Set DataSht = Application.ThisWorkbook.Sheets("Data")

    'LastRowData = DataSht.Cells(DataSht.Rows.Count, "A").End(xlUp).Row
    LastRowData = DataSht.Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    LastColumnData = DataSht.Cells(1, DataSht.Columns.Count).End(xlToLeft).Column

Set SrcData = DataSht.Range(DataSht.Cells(1, 1), DataSht.Cells(LastRowData + 1, LastColumnData))

StartPvt = ws.Name & "!" & ws.Range("B2").Address(ReferenceStyle:=xlR2C2)

Set PC = Application.ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
          SourceData:=SrcData)
          
Set PT = PC.CreatePivotTable(StartPvt, "AtlasCopcoPvt")
 

    With ws.PivotTables("AtlasCopcoPvt")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ws.PivotTables("AtlasCopcoPvt").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ws.PivotTables("AtlasCopcoPvt").RepeatAllLabels xlRepeatLabels
    With ws.PivotTables("AtlasCopcoPvt").PivotFields("PRO ID")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ws.PivotTables("AtlasCopcoPvt").PivotFields("FIRST NAME")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ws.PivotTables("AtlasCopcoPvt").PivotFields("LAST NAME")
        .Orientation = xlRowField
        .Position = 3
    End With

    ws.PivotTables("AtlasCopcoPvt").AddDataField ws.PivotTables( _
        "AtlasCopcoPvt").PivotFields("AMOUNT"), "Sum of DOLLARS", xlSum
    With ws.PivotTables("AtlasCopcoPvt").PivotFields("E/D-CODE")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ws.PivotTables("AtlasCopcoPvt").PivotFields("AMT TYPE")
        .Orientation = xlPageField
        .Position = 2
    End With
    With ws.PivotTables("AtlasCopcoPvt").PivotFields("SUBPAY")
        .Orientation = xlPageField
        .Position = 3
    End With
    
    ws.PivotTables("AtlasCopcoPvt").PivotFields("SUBPAY").ClearAllFilters
    ws.PivotTables("AtlasCopcoPvt").PivotFields("SUBPAY").CurrentPage = "(All)"
    
'    If AmountTypeCheck = "Yes" Then
'        ws.PivotTables("AtlasCopcoPvt").PivotFields("AMT TYPE").CurrentPage = Typ2
'
'    End If

    ws.PivotTables("AtlasCopcoPvt").PivotFields("AMT TYPE").ClearAllFilters
    ws.PivotTables("AtlasCopcoPvt").PivotFields("AMT TYPE").CurrentPage = "(All)"
    
    
    With ws.PivotTables("AtlasCopcoPvt")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    
    With ws.PivotTables("AtlasCopcoPvt")
        For Each pvtFld In .PivotFields
            pvtFld.Subtotals(1) = True
            pvtFld.Subtotals(1) = False
        Next pvtFld
    End With
        


'Check if regular salary is over 80 hours
val = Application.WorksheetFunction.CountIf(ThisWorkbook.Worksheets("Data").Range("D:D"), Code)

If val > 0 Then
    ws.PivotTables("AtlasCopcoPvt").PivotFields("E/D-CODE").CurrentPage = Code
        
    LastRow2 = wb.Worksheets("Calc").Cells(Rows.Count, "B").End(xlUp).Row - 1

    For e = 5 To LastRow2
    
        If ThisWorkbook.Worksheets("Calc").Range("E" & e) > 80 Then
            f = f + 1
            FirstLastName = "(" & ThisWorkbook.Worksheets("Calc").Range("C" & e) & " " & ThisWorkbook.Worksheets("Calc").Range("D" & e) & ")"
            If FirstLastName = "((blank) (blank))" Then
                wb.Worksheets("Result").Range("B" & 1 + f) = "EmpID " & ThisWorkbook.Worksheets("Calc").Range("B" & e) & " has more than 80 hours regular pay"
            Else
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 191488 bytes
SHA-256: 47b1f1f4a51bab128cb8b96c5931cf25cb7b99bab63711e661fec1bb67cc8ffb

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