Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 f6389766e9ace1a6…

MALICIOUS

Office (OLE)

382.5 KB Created: 2007-06-27 07:31:03 Authoring application: Microsoft Excel First seen: 2016-06-30
MD5: 5265a8860f09ee6467e2f99082b10db3 SHA-1: a17dd448aa8261e94cc30d940a0247943313f0fd SHA-256: f6389766e9ace1a6edd2dc034ed613ce1d4a7a7682660094e145ae228bed3164
90 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1566.001 Spearphishing Attachment

The file is identified as malicious by ClamAV and contains VBA macros, including a Workbook_Open event, indicating it is designed to execute code upon opening. The document body, while appearing to be a Bill of Quantities, contains text that attempts to mislead the user into believing it's a legitimate tender document. The VBA code likely prepares for or initiates the download of a secondary payload, although the specific download URL is not directly present in the provided script excerpt.

Heuristics 4

  • ClamAV: Xls.Malware.Madeba-8024067-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Xls.Malware.Madeba-8024067-0
  • VBA macros detected medium 1 related finding OLE_VBA_MACROS
    Document contains VBA macro code
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Private Sub Workbook_Open()
  • 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 http://www.w3.org/2001/XMLSchema In document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 97243 bytes
SHA-256: b33c74adba1c3c5a12bafa8ae5abfb1ab485a827b49608281d479b06e503f0da
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
'Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Sheets.Count >= 1 Then
        If ActiveSheet.Cells(1, 13).Value = 1 Then  'MsgBox "boq sheet itemrate" & sheetcount
            Call itemratecheck
        ElseIf ActiveSheet.Cells(1, 13).Value = 2 Then 'MsgBox "boq sheet percentage" & sheetcount
            Call percentagecheck
        ElseIf ActiveSheet.Cells(1, 13).Value = 3 Then 'MsgBox "boq sheet itemwise" & sheetcount
            Call itemwisecheck
        Else
            MsgBox "Invalid BoQ!!! Please download the BoQ from the Downloads section of eProc Portal"
        End If
    End If
End Sub

Private Sub Workbook_Open()
    Call warningmsg
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call warningmsg
    Call displaybutton
End Sub

Attribute VB_Name = "Module1"
'This function will work upto 99,99,99,99,999.99
 

Option Explicit
'-- Updated on II/11/2011. Updated up to 9999 Thousan crores
'-- Modified as per requirement and updated as on 15/09/2011



Function SpellNumber(kapil As Double)

'Attribute Macro4.VB_Description = "Macro recorded 05/01/01 by Shailesh Agrawal"
'Attribute Macro4.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro4"
' Your comments and Feed back will be most appreciated.
' Macro4 Macro
' Macro recorded 05/01/2001 by Shailesh Agrawal Associates
' This macro is available free of cost at www.CharteredValuer.com
' For Further inquiry feel free to contact on shashi@CharteredValuer.com
' This is distributed as freeware. We do not take any responsiblity for any problem
' due to this macro
' Updated to work up 9999 Thousand Crores of Indian Rupees. by KSR on 3/09/2011

Dim words(100) As String
 words(0) = "Zero"
 words(1) = "One"
 words(2) = "Two"
 words(3) = "Three"
 words(4) = "Four"
 words(5) = "Five"
 words(6) = "Six"
 words(7) = "Seven"
 words(8) = "Eight"
 words(9) = "Nine"
 words(10) = "Ten"
 words(11) = "Eleven"
 words(12) = "Twelve"
 words(13) = "Thirteen"
 words(14) = "Fourteen"
 words(15) = "Fifteen"
 words(16) = "Sixteen"
 words(17) = "Seventeen"
 words(18) = "Eighteen"
 words(19) = "Nineteen"
 words(20) = "Twenty"
 words(21) = "Twenty One"
 words(22) = "Twenty Two"
 words(23) = "Twenty Three"
 words(24) = "Twenty Four"
 words(25) = "Twenty Five"
 words(26) = "Twenty Six"
 words(27) = "Twenty Seven"
 words(28) = "Twenty Eight"
 words(29) = "Twenty Nine"
 words(30) = "Thirty"
 words(31) = "Thirty One"
 words(32) = "Thirty Two"
 words(33) = "Thirty Three"
 words(34) = "Thirty Four"
 words(35) = "Thirty Five"
 words(36) = "Thirty Six"
 words(37) = "Thirty Seven"
 words(38) = "Thirty Eight"
 words(39) = "Thirty Nine"
 words(40) = "Fourty"
 words(41) = "Fourty One"
 words(42) = "Fourty Two"
 words(43) = "Fourty Three"
 words(44) = "Fourty Four"
 words(45) = "Fourty Five"
 words(46) = "Fourty Six"
 words(47) = "Fourty Seven"
 words(48) = "Fourty Eight"
 words(49) = "Fourty Nine"
 words(50) = "Fifty"
 words(51) = "Fifty One"
 words(52) = "Fifty Two"
 words(53) = "Fifty Three"
 words(54) = "Fifty Four"
 words(55) = "Fifty Five"
 words(56) = "Fifty Six"
 words(57) = "Fifty Seven"
 words(58) = "Fifty Eight"
 words(59) = "Fifty Nine"
 words(60) = "Sixty"
 words(61) = "Sixty One"
 words(62) = "Sixty Two"
 words(63) = "Sixty Three"
 words(64) = "Sixty Four"
 words(65) = "Sixty Five"
 words(66) = "Sixty Six"
 words(67) = "Sixty Seven"
 words(68) = "Sixty Eight"
 words(69) = "Sixty Nine"
 words(70) = "Seventy"
 words(71) = "Seventy One"
 words(72) = "Seventy Two"
 words(73) = "Seventy Three"
 words(74) = "Seventy Four"
 words(75) = "Seventy Five"
 words(76) = "Seventy Six"
 words(77) = "Seventy Seven"
 words(78) = "Seventy Eight"
 words(79) = "Seventy Nine"
 words(80) = "Eighty"
 words(81) = "Eighty One"
 words(82) = "Eighty Two"
 words(83) = "Eighty Three"
 words(84) = "Eighty Four"
 words(85) = "Eighty Five"
 words(86) = "Eighty Six"
 words(87) = "Eighty Seven"
 words(88) = "Eighty Eight"
 words(89) = "Eighty Nine"
 words(90) = "Ninety"
 words(91) = "Ninety One"
 words(92) = "Ninety Two"
 words(93) = "Ninety Three"
 words(94) = "Ninety Four"
 words(95) = "Ninety Five"
 words(96) = "Ninety Six"
 words(97) = "Ninety Seven"
 words(98) = "Ninety Eight"
 words(99) = "Ninety Nine"
 words(100) = "One Hundred"

Dim GHAU As String
Dim CRORE As String
Dim LAKH As String
Dim thousand As String, ERUPT As Variant
Dim HUNDRED As String
'==========================================
Dim AJEB1   As Variant
Dim BINDRZ  As Variant
Dim BOROS   As Variant, BORIS As Variant
Dim BORUS   As Variant, CYRUS As Variant, CYROS1 As Variant
Dim DOZAL   As Variant
Dim GRIPP1  As String
Dim GRIPP2  As Long
Dim GRIPP3  As Variant, PAISE As String
Dim GXZP0   As String, tmpand As String, GXZP99 As String
Dim GXZP1   As String, GXZP2 As String, GXZP3 As String
Dim GXZP4   As String, GXZP5 As String, GXZP6 As String, GXZP7 As String
Dim HARP1   As Variant, HARP2 As Variant, HARP3 As Variant
Dim HARP4   As Variant, HARP5 As Variant, HARP6 As Variant
Dim HARP7   As Variant
Dim JANTI   As Variant, JANTI1 As Variant, JANTI2 As Variant, JANTI3 As Variant
Dim KARANT1 As Variant, KARANT2 As Variant, KARANT3 As Variant
Dim KARANT4 As Variant, KARANT5 As Variant, KARANT6 As Variant
Dim KARANT7 As Variant, KARANT8 As Variant, KARANT9 As Variant
Dim KARANT10 As Variant
Dim LINZUR1 As Variant, LINZUR2 As Variant, LINZUR3 As Variant
Dim LINZUR4 As Variant, LINZUR5 As Variant, LINZUR  As Variant
Dim PAST1   As Variant, PAST2 As Variant, PAST3 As Variant
Dim PAST4   As Variant, PAST5 As Variant, PAST12 As Variant
Dim RABJI1  As String
Dim XORE6   As String
Dim XORE7   As Variant, XORE8 As Variant
Dim XYME    As Variant
Dim XYZ     As String, FLITIES As Variant
Dim ZZART   As Variant
GXZP6 = " "
GXZP7 = " "

'-- Limits in place 2004-09-23 ...
If kapil = 0 Then
  SpellNumber = "Rupees" _
            & " only"
  Exit Function
End If
If kapil > 99999999999.99 Then
  SpellNumber = "High Value" _
            & " "
  Exit Function
End If

BINDRZ = kapil
PAST1 = BINDRZ - Int(BINDRZ)
PAST12 = Round((PAST1 * 100), 0)

PAST2 = Int(PAST12)
PAST3 = Str(PAST2)
PAST4 = Val(PAST3)
JANTI = Str(Int(BINDRZ))
JANTI1 = Val(JANTI)
JANTI2 = Int(JANTI1)
AJEB1 = Str(JANTI2)
CRORE = " Crore "
LAKH = " Lakh "
thousand = " Thousand "
HUNDRED = " Hundred "
PAISE = "and Paise"
tmpand = " "
GXZP0 = " "
GXZP1 = " "
GXZP2 = " "
GXZP3 = " "
GXZP4 = " "
GXZP5 = " "
GXZP6 = " "
GXZP7 = " "
XYZ = "& "
RABJI1 = Trim(AJEB1)

If Len(RABJI1) > 10 Then
 KARANT1 = Right(RABJI1, 11)
 KARANT2 = Right(RABJI1, 10)
 KARANT3 = Val(KARANT1) - Val(KARANT2)
 KARANT4 = KARANT3 / 10000000000#
 KARANT5 = Str(KARANT4)
 KARANT6 = Right(KARANT5, 2)
 KARANT7 = Val(KARANT6)
 If KARANT7 > 0 Then
   KARANT10 = words(KARANT7) + " Thousand "
 Else
   KARANT8 = ""
'   CRORE = ""
   GXZP99 = ""
 End If
Else
' KARANT8 = ""
' CRORE = ""
 GXZP0 = ""
End If

If Len(RABJI1) > 8 Then
 KARANT1 = Right(RABJI1, 10)
 KARANT2 = Right(RABJI1, 9)
 KARANT3 = Val(KARANT1) - Val(KARANT2)
 KARANT4 = KARANT3 / 1000000000
 KARANT5 = Str(KARANT4)
 KARANT6 = Right(KARANT5, 2)
 KARANT7 = Val(KARANT6)
 If KARANT7 > 0 Then
   KARANT9 = words(KARANT7) + " Hundred "
 Else
   KARANT8 = ""
'   CRORE = ""
   GXZP0 = ""
 End If
Else
' KARANT8 = ""
' CRORE = ""
 GXZP0 = ""
End If

If Len(RABJI1) > 7 Then
 KARANT1 = Right(RABJI1, 9)
 KARANT2 = Right(RABJI1, 7)
 KARANT3 = Val(KARANT1) - Val(KARANT2)
 KARANT4 = KARANT3 / 10000000
 KARANT5 = Str(KARANT4)
 KARANT6 = Right(KARANT5, 2)
 KARANT7 = Val(KARANT6)
 If KARANT7 > 0 Then
    If GXZP0 = " " Then
        tmpand = " and "
    End If
   KARANT8 = tmpand + words(KARANT7)
 Else
   KARANT8 = ""
'   CRORE = ""
'   GXZP1 = ""
 End If
Else
 KARANT8 = ""
 CRORE = ""
 GXZP1 = ""
End If
If Len(RABJI1) > 5 Then
 LINZUR = Right(RABJI1, 5)
 LINZUR2 = Val(RABJI1) - Val(LINZUR)
 LINZUR3 = LINZUR2 / 100000
 XORE6 = Str(LINZUR3)
 XORE7 = Right(XORE6, 2)
 XORE8 = Val(XORE7)
 If XORE8 > 0 Then
   LINZUR4 = words(XORE8)
 Else
   LINZUR4 = ""
   LAKH = ""
   GXZP2 = ""
 End If
   Else
   LINZUR4 = ""
   LAKH = ""
   GXZP2 = ""
End If
If Len(RABJI1) > 3 Then
 HARP1 = Right(RABJI1, 3)
 HARP2 = Val(RABJI1) - Val(HARP1)
 HARP3 = HARP2 / 1000
 HARP4 = Str(HARP3)
 HARP5 = Right(HARP4, 2)
 HARP6 = Val(HARP5)
 If HARP6 > 0 Then
   HARP7 = words(HARP6)
 Else
   HARP7 = ""
   thousand = ""
   GXZP3 = ""
 End If
Else
 HARP7 = ""
 thousand = ""
 GXZP3 = ""
End If
If Len(RABJI1) > 2 Then
 BORIS = Right(RABJI1, 3)
 CYRUS = Left(BORIS, 1)
 CYROS1 = Val(CYRUS)
 If CYROS1 > 0 Then
   ERUPT = words(CYROS1)
 Else
   ERUPT = ""
   HUNDRED = ""
   GXZP4 = ""
 End If
Else
 ERUPT = ""
 HUNDRED = ""
 GXZP4 = ""
End If
If Len(RABJI1) > 1 Then
 ZZART = Right(RABJI1, 2)
 DOZAL = Val(ZZART)
 If DOZAL > 0 Then
   FLITIES = words(DOZAL)
 Else
   FLITIES = ""
   XYZ = ""
 End If
Else
 FLITIES = ""
 XYZ = ""
End If
If Len(RABJI1) < 2 And Len(RABJI1) > 0 Then
 GRIPP1 = Left(RABJI1, 1)
 GRIPP2 = Val(GRIPP1)
 XYZ = ""
 GXZP5 = ""
 GXZP6 = ""
 If GRIPP2 > 0 Then
   GRIPP3 = words(GRIPP2)
 Else
   GRIPP3 = ""
 End If
Else
 GRIPP3 = ""
End If
If Len(RABJI1) < 3 And Len(RABJI1) > 0 Then
 XYZ = ""
 GXZP5 = ""
 GXZP6 = ""
End If
If PAST4 > 0 Then
    PAST5 = words(PAST4)
 Else
 PAST5 = ""
 PAISE = ""
 GXZP7 = ""
End If
XYME = Val(AJEB1)
GHAU = "Rupees " + Trim(KARANT10) + GXZP99 + " " + Trim(KARANT9) + GXZP0 + " " + Trim(KARANT8) + GXZP1 + Trim(CRORE) _
  + GXZP1 + Trim(LINZUR4) + GXZP2 + Trim(LAKH) + GXZP2 _
  + Trim(HARP7) + GXZP3 + Trim(thousand) + GXZP3 _
  + Trim(ERUPT) + GXZP4 + Trim(HUNDRED) + GXZP5 + XYZ _
  + GXZP4 + Trim(FLITIES) + GXZP6 + Trim(GRIPP3) _
  + GXZP7 + Trim(PAISE) + GXZP7 + Trim(PAST5) + " Only"

SpellNumber = GHAU
End Function





Attribute VB_Name = "Sheet2"
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
Attribute VB_Control = "VALIDATE, 60, 0, MSForms, CommandButton"
Attribute VB_Control = "HELP, 72, 6, MSForms, CommandButton"
Attribute VB_Control = "PRINT, 71, 7, MSForms, CommandButton"
Private Sub VALIDATE_Click()
    If ActiveSheet.Cells(1, 13).Value = 1 Then  'MsgBox "boq sheet itemrate" & sheetcount
        Call itemratecheck
    ElseIf ActiveSheet.Cells(1, 13).Value = 2 Then 'MsgBox "boq sheet percentage" & sheetcount
        Call percentagecheck
    ElseIf ActiveSheet.Cells(1, 13).Value = 3 Then  'MsgBox "boq sheet itemwise" & sheetcount
        Call itemwisecheck
    End If
End Sub

Private Sub PRINT_Click()
    ActiveWindow.SelectedSheets.PrintPreview
End Sub

Private Sub HELP_Click()
    MsgBox "Please refer How to prepare BoQ Guidelines Document", vbInformation, "GePNIC BoQ Validation"
End Sub

Attribute VB_Name = "Module2"
'Option Explicit
' This check boq validation support for All types of boq with single and multiple sheets

Function itemratecheck()
    boqsheetname = "BoQ" & ActiveSheet.Index
    LastRow = ActiveSheet.UsedRange.Rows.Count
    intRowCount = LastRow - 2
    Success = "S"
        If ActiveSheet.ProtectContents = False And ActiveSheet.Cells(2, 13).Value <> "BoQ_Ver2.0" Then
            MsgBox " Invalid BoQ!!! Please download the BoQ from the Downloads section of eProc Portal" & Chr(13)
        ElseIf ActiveSheet.ProtectContents = True And ActiveSheet.Cells(2, 13).Value = "BoQ_Ver2.0" And ActiveSheet.Cells(3, 13).Value <> "Yes" Then
            ActiveSheet.Cells(3, 13).Value = " "
            MsgBox "Warning ! Some issues are found in the BoQ, Please unprotect and Correct the issues", vbCritical, "GePNIC BoQ Validation"
        ElseIf ActiveSheet.ProtectContents = False And ActiveSheet.Cells(2, 13).Value = "BoQ_Ver2.0" And ActiveSheet.Cells(3, 13).Value = "Yes" Then
            ActiveSheet.Cells(3, 13).Value = " "
        End If
        
        If ActiveSheet.Cells(2, 13).Value = "BoQ_Ver2.0" And ActiveSheet.ProtectContents = False And ActiveSheet.Cells(2, 13).Value <> "Yes" Then
           ActiveSheet.Cells(3, 13).Value = " "
        c = 0
         
        Range("A8:E" & LastRow).Interior.ColorIndex = xlNone
        Range("G8:H" & LastRow).Interior.ColorIndex = xlNone
         
        'Check all the items in the spreadsheet
        LLoop = 8
        While LLoop <= LastRow - 2
            LChangedValue = "A" & CStr(LLoop)
            If Len(Range(LChangedValue).Value) > 0 Then
                'Test each value for uniqueness
                LTestLoop = 2
                While LTestLoop <= LastRow - 2
                    If LLoop <> LTestLoop Then
                        LTestValue = "A" & CStr(LTestLoop)
                        'Value has been duplicated in another cell
                        If Range(LChangedValue).Value = Range(LTestValue).Value Then
                        'Set the background color to red
                                Range(LChangedValue).Interior.ColorIndex = 3
                                Range(LTestValue).Interior.ColorIndex = 3
                            msgdup = "0. Please remove duplicate S.Nos highlight in Background Color" & Chr(13)
                        End If
                    End If
                    LTestLoop = LTestLoop + 1
                Wend
            End If
            LLoop = LLoop + 1
        Wend
        
        For i = 8 To intRowCount
            msg1 = ""
            If ActiveSheet.Cells(i, 1).NumberFormat <> "0.00" Then
                c = c + 1
                msg1 = c & ". Please assign S.No in Number format for the S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 1).Interior.ColorIndex = 3
            ElseIf Not IsNumeric(ActiveSheet.Cells(i, 3).Value) Or Not IsNumeric(ActiveSheet.Cells(i, 5).Value) Or Not IsNumeric(ActiveSheet.Cells(i, 6).Value) Or Not IsNumeric(ActiveSheet.Cells(i, 8).Value) Then
                    MsgBox "Please Enter Valid Data for Numeric Columns for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                    End
            ElseIf ActiveSheet.Cells(i, 1).Value = vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please enter the S.No for the description ' " & ActiveSheet.Cells(i, 2) & " '" & Chr(13)
                ActiveSheet.Cells(i, 1).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 2).Value = vbNullString And ActiveSheet.Cells(i, 1).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please enter the Item Description for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 2).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 3).NumberFormat <> "0.00" And ActiveSheet.Cells(i, 1).Value <> vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString And ActiveSheet.Cells(i, 4).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Format Error!! Please assign the Quantity in Number format for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 3).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 3).Value < 0.01 And ActiveSheet.Cells(i, 1).Value <> vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString And ActiveSheet.Cells(i, 4).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Format Error!! Please enter the Quantity greater than or equal to One for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 3).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 3).Value = vbNullString And ActiveSheet.Cells(i, 1).Value <> vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString And ActiveSheet.Cells(i, 4).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please enter the Quantity for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 3).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 4).Value = vbNullString And ActiveSheet.Cells(i, 1).Value <> vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please enter the Units for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 4).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 5).NumberFormat <> "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Format Error!! Please assign the valid Estimated Rate format for S.No  " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 5).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 6).NumberFormat <> "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Format Error!! Please assign the Rate in Number format for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 6).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 6).NumberFormat = "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString And ActiveSheet.Cells(i, 6).Locked = True Then
                c = c + 1
                msg1 = c & ". Please Unprotect the Rate Cell for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 6).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 6).Value <> "" And ActiveSheet.Cells(i, 3).Value <> vbNullString And ActiveSheet.Cells(i, 6).Locked = False Then
                c = c + 1
                msg1 = c & ". Please set the Rate as Blank value for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 6).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 6).Value = " " And ActiveSheet.Cells(i, 3).Value = vbNullString And ActiveSheet.Cells(i, 6).Locked = False Then
                c = c + 1
                msg1 = c & ". Please Protect the Rate Cell for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 6).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 7).Value <> "Rupees only" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Formula Error!! Please Enter 0 for Rate or fix the valid formula for Amount in Words for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 7).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 7).Value = "Rupees only" And ActiveSheet.Cells(i, 3).Value = vbNullString Then
                c = c + 1
                msg1 = c & ". Formula Error!! Please remove the Amount in Words formula for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 7).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 8).NumberFormat <> "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Format Error!! Please assign the Amount in Number format for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 8).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 8).NumberFormat = "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString And ActiveSheet.Cells(i, 8).Locked = False Then
                 c = c + 1
                msg1 = c & ". Please protect the Amount Cell for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 8).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 8).Value = "" And ActiveSheet.Cells(i, 8).NumberFormat = "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString And ActiveSheet.Cells(i, 8).Locked = True Then
                c = c + 1
                msg1 = c & ". Formula Error!! Please set valid formula for Amount Cell for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 8).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 8).Value <> "" And ActiveSheet.Cells(i, 3).Value = vbNullString Then
                c = c + 1
                msg1 = c & ". Formula Error!! Please remove the Amount formula for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 8).Interior.ColorIndex = 3
            End If
            
            msg = msg + "" + msg1
        Next i
                        
            If ActiveSheet.Cells(1, 13).Value = vbNullString Then
                c = c + 1
                msg2 = c & ". Invalid BoQ!!! Please download the BoQ from the Downloads section of eProc Portal" & Chr(13)
                ActiveSheet.Cells(i, 13).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Name <> boqsheetname Then
                c = c + 1
                msg3 = c & ". BoQ Sheet Name Error !!! Excel Sheet should be named as " & boqsheetname & Chr(13)
            End If
            If ActiveSheet.Cells(1, 1).Value = vbNullString Then
                c = c + 1
                msg4 = c & ". Header Error! Please enter the 'Tender Inviting Authority Details' in Row No: 1 " & Chr(13)
                ActiveSheet.Cells(1, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(2, 1).Value = vbNullString Then
                c = c + 1
                msg5 = c & ". Header Error! Please enter the 'Name of the Work / Details' in Row No: 2 " & Chr(13)
                ActiveSheet.Cells(2, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(3, 1).Value = vbNullString Then
                c = c + 1
                msg6 = c & ". Header Error! Please enter the 'Contract No' in Row No: 3 " & Chr(13)
                ActiveSheet.Cells(3, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(4, 2).Value <> vbNullString Then
                c = c + 1
                msg7 = c & ". Header Value Error! Please remove the Bidder Name " & ActiveSheet.Cells(4, 2) & Chr(13)
                ActiveSheet.Cells(4, 2).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(5, 1).Value = vbNullString Then
                c = c + 1
                msg8 = c & ". Header Error! Please enter the 'SCHEDULE OF WORKS' in Row No: 5 " & Chr(13)
                ActiveSheet.Cells(5, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(7, 1).Value <> vbNullString Or ActiveSheet.Cells(7, 2).Value <> vbNullString Or ActiveSheet.Cells(7, 3).Value <> vbNullString Or ActiveSheet.Cells(7, 4).Value <> vbNullString Then
                c = c + 1
                msg81 = c & ". Header Error! Please remove the content from Row No: 7 " & Chr(13)
                'ActiveSheet.Cells(7, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(LastRow, 1).Value <> "Total in Words" Then
                c = c + 1
                msg9 = c & ". Footer Error!! Last Row doesn't contain Total in Words " & Chr(13)
                ActiveSheet.Cells(LastRow, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(LastRow - 1, 1).Value <> "Total in Figures" Then
                c = c + 1
                msg10 = c & ". Footer Error!! Last but one row doesn't contain Total in Figures" & Chr(13)
                ActiveSheet.Cells(LastRow - 1, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(LastRow - 1, 3).Value <> 0 Then
                c = c + 1
                msg101 = c & ". Footer Error!! Last but one row doesn't contain the formulla for Total in Figures" & Chr(13)
                ActiveSheet.Cells(LastRow - 1, 3).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(LastRow, 3).Value <> "Rupees only" Then
                c = c + 1
                msg11 = c & ". Formula Error!!! Please assign the Total Amount in Words formula for Last Row " & Chr(13)
                ActiveSheet.Cells(LastRow, 3).Interior.ColorIndex = 3
            End If
            
            msg = msgdup + "" + msg + "" + msg2 + "" + msg3 + "" + msg4 + "" + msg5 + "" + msg6 + "" + msg7 + "" + msg8 + "" + msg81 + "" + msg9 + "" + msg10 + "" + msg101 + "" + msg11 + "" + msg12
            
            If msg <> "" Then
                If ActiveSheet.ProtectContents = True Then
                    MsgBox "Failure!!! Please unprotect the BoQ and Correct the errors"
                Else
                    MsgBox "Failure !!! The following issues are found in the BoQ" + Chr(13) + Chr(13) + msg, vbInformation, "GePNIC BoQ Validation"
                    Call Unprotectsheet
                End If
            Else
                MsgBox "Success !!! The basic validations are Ok for this BoQ. Please protect the BoQ and proceed further", vbInformation, "GePNIC BoQ Validation"
                ActiveSheet.Cells(2, 13).Value = "BoQ_Ver2.0"
                ActiveSheet.Cells(3, 13).Value = "Yes"
                ActiveSheet.Cells(4, 2).Interior.ColorIndex = 35
                Call protectsheet
                
                'The ABCDE values moves to IA,IB,IC,ID,IE (ie.235,236,237,238,239) cells
                For k = 8 To LastRow - 2
                    ActiveSheet.Cells(k, 235) = ActiveSheet.Cells(k, 1)
                    ActiveSheet.Cells(k, 236) = ActiveSheet.Cells(k, 2)
                    ActiveSheet.Cells(k, 237) = ActiveSheet.Cells(k, 3)
                    ActiveSheet.Cells(k, 238) = ActiveSheet.Cells(k, 4)
                    ActiveSheet.Cells(k, 239) = ActiveSheet.Cells(k, 5)
                    If ActiveSheet.Cells(k, 6).Value = "" And ActiveSheet.Cells(k, 3).Value <> vbNullString And ActiveSheet.Cells(k, 6).Locked = False Then
                        ActiveSheet.Cells(k, 6).Interior.ColorIndex = 35
                    End If
                Next k
                    'MsgBox "ABCDE Pasted Successfully"
            End If
        
        'Validation start for Bidders
        ElseIf ActiveSheet.ProtectContents = True And ActiveSheet.Cells(2, 13).Value = "BoQ_Ver2.0" And ActiveSheet.Cells(3, 13).Value = "Yes" Then
            c = 0
            For i = 8 To intRowCount
                If ActiveSheet.Cells(i, 1).Value = vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString Then
                    c = c + 1
                    msg1 = c & ". Please enter the S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ElseIf ActiveSheet.Cells(i, 2).Value = vbNullString And ActiveSheet.Cells(i, 1).Value <> vbNullString Then
                    c = c + 1
                    msg1 = c & ". Please enter the Item Description for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ElseIf ActiveSheet.Cells(i, 3).Value = vbNullString And ActiveSheet.Cells(i, 1).Value <> vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString And ActiveSheet.Cells(i, 4).Value <> vbNullString Then
                    c = c + 1
                    msg1 = c & ". Please enter the Quantity for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ElseIf ActiveSheet.Cells(i, 4).Value = vbNullString And ActiveSheet.Cells(i, 1).Value <> vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                    c = c + 1
                    msg1 = c & ". Please enter the Units for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ElseIf ActiveSheet.Cells(i, 5).NumberFormat <> "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                    c = c + 1
                    msg1 = c & ". Please assign the Estimated Rate in Number format for S.No  " & ActiveSheet.Cells(i, 1) & Chr(13)
                ElseIf ActiveSheet.Cells(i, 5).Value <> "" And ActiveSheet.Cells(i, 3).Value = vbNullString Then
                    c = c + 1
                    msg1 = c & ". Please remove the Estimated Rate for S.No  " & ActiveSheet.Cells(i, 1) & Chr(13)
                ElseIf ActiveSheet.Cells(i, 6).NumberFormat <> "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                    c = c + 1
                    msg1 = c & ". Please assign the Rate in Number format for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                'ElseIf ActiveSheet.Cells(i, 6).Value = 0 And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                    'c = c + 1
                    'msg1 = c & ". Please enter the Rate for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ElseIf ActiveSheet.Cells(i, 6).Value = "" And ActiveSheet.Cells(i, 3).Value <> vbNullString And ActiveSheet.Cells(i, 6).Locked = False Then
                    c = c + 1
                    msg1 = c & ". Please Enter the Rate for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ElseIf ActiveSheet.Cells(i, 7).Value = vbNullString And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                    c = c + 1
                    msg1 = c & ". Formula Error ! Please set valid formula for Amount in Words for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ElseIf ActiveSheet.Cells(i, 7).Value = "Rupees only" And ActiveSheet.Cells(i, 3).Value = vbNullString Then
                    c = c + 1
                    msg1 = c & ". Please remove the Amount in Words formula for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ElseIf ActiveSheet.Cells(i, 8).Value = 0 And ActiveSheet.Cells(i, 8).NumberFormat <> "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                    c = c + 1
                    msg1 = c & ". Please assign the Amount in Number format for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                'ElseIf ActiveSheet.Cells(i, 8).Value = 0 And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                    'c = c + 1
                    'msg1 = c & ". Formula Error ! Please Enter the Amount formula for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                End If
                msg = msg + "" + msg1
                msg1 = ""
            Next i
            
                If ActiveSheet.Cells(1, 13).Value = vbNullString Then
                    c = c + 1
                    msg2 = c & ". Invalid BoQ!! Please download the BoQ of the relevent Tender from eProc Portal" & Chr(13)
                End If
                If ActiveSheet.Name <> boqsheetname Then
                    c = c + 1
                    msg3 = c & ". Sheet Name Error!! Excel sheet should be named as " & boqsheetname & Chr(13)
                End If
                If ActiveSheet.Cells(1, 1).Value = vbNullString Then
                    c = c + 1
                    msg4 = c & ". Header Error!! Please Enter the 'Tender Inviting Authority Details' in Row No: 1 " & Chr(13)
                End If
                If ActiveSheet.Cells(2, 1).Value = vbNullString Then
                    c = c + 1
                    msg5 = c & ". Header Error!! Please Enter the 'Name of the Work / Details' in Row No: 2 " & Chr(13)
                End If
                If ActiveSheet.Cells(3, 1).Value = vbNullString Then
                    c = c + 1
                    msg6 = c & ". Header Error!! Please Enter the 'Contract No' in Row No: 3 " & Chr(13)
                End If
                If ActiveSheet.Cells(4, 2).Value = vbNullString Then
                    c = c + 1
                    msg7 = c & ". Header Error!! Please Enter the Bidder Name " & ActiveSheet.Cells(4, 2) & Chr(13)
                End If
                If ActiveSheet.Cells(5, 1).Value = vbNullString Then
                    c = c + 1
                    msg8 = c & ". Header Error!! Please Enter the 'SCHEDULE OF WORKS' in Row No: 5 " & Chr(13)
                End If
                If ActiveSheet.Cells(LastRow, 1).Value <> "Total in Words" Then
                    c = c + 1
                    msg9 = c & ". Footer Error!! Last Row doesn't contain Total in Words " & Chr(13)
                End If
                If ActiveSheet.Cells(LastRow - 1, 1).Value <> "Total in Figures" Then
                    c = c + 1
                    msg10 = c & ". Footer Error!! Last before Row doesn't contain Total in Figures" & Chr(13)
                End If
                If ActiveSheet.Cells(LastRow, 3).Value = vbNullString Then
                    c = c + 1
                    msg11 = c & ". Formula Error!!! Please assign the Total Amount in Words formula for Last Row " & Chr(13)
                End If
                
                
                'Checking for Tampared/Violated
         
                'Check all the items in the spreadsheet
                LLoop = 8
                While LLoop <= LastRow - 2
                    LChangedValueA = "A" & CStr(LLoop)
                    LChangedValueB = "B" & CStr(LLoop)
                    LChangedValueC = "C" & CStr(LLoop)
                    LChangedValueD = "D" & CStr(LLoop)
                    If Len(Range(LChangedValueA).Value) > 0 Then
                            'Test each value for uniqueness
                        LTestLoop = 1
                        While LTestLoop <= LastRow - 2
                            If LLoop = LTestLoop Then
                                LTestValueA = "IA" & CStr(LTestLoop)
                                If Range(LChangedValueA).Value <> Range(LTestValueA).Value Then
                                    msgtampared = "0. This BoQ is Tampared in S.Nos " & ActiveSheet.Cells(LLoop, 1) & Chr(13)
                                End If
                                
                                LTestValueB = "IB" & CStr(LTestLoop)
                                If Range(LChangedValueB).Value <> Range(LTestValueB).Value Then
                                    msgtampared = "0. This BoQ is Tampared in S.Nos " & ActiveSheet.Cells(LLoop, 1) & Chr(13)
                                End If
                                
                                LTestValueC = "IC" & CStr(LTestLoop)
                                If Range(LChangedValueC).Value <> Range(LTestValueC).Value Then
                                    msgtampared = "0. This BoQ is Tampared in S.Nos " & ActiveSheet.Cells(LLoop, 1) & Chr(13)
                                End If
                                
                                LTestValueD = "ID" & CStr(LTestLoop)
                                If Range(LChangedValueD).Value <> Range(LTestValueD).Value Then
                                    msgtampared = "0. This BoQ is Tampared in S.Nos " & ActiveSheet.Cells(LLoop, 1) & Chr(13)
                                End If
                            End If
                            LTestLoop = LTestLoop + 1
                        Wend
                    End If
                    LLoop = LLoop + 1
                Wend
                
                msg = msgtampared + "" + msg + "" + msg2 + "" + msg3 + "" + msg4 + "" + msg5 + "" + msg6 + "" + msg7 + "" + msg8 + "" + msg9 + "" + msg10 + "" + msg11
                If msg <> "" Then
                    MsgBox "Failure !!! The following issues are found in the BoQ, Please correct these." + Chr(13) + Chr(13) + msg, vbInformation, "GePNIC BoQ Validation"
                Else
                    MsgBox "Success !!! The basic validations are Ok for this BoQ. Please Save the BoQ and proceed further", vbInformation, "GePNIC BoQ Validation"
                    ActiveSheet.Cells(2, 13).Value = "BoQ_Ver2.0"
                End If
        End If
End Function
Function percentagecheck()
    boqsheetname = "BoQ" & ActiveSheet.Index
    LastRow = ActiveSheet.UsedRange.Rows.Count
    intRowCount = LastRow - 3
    Success = "S"
        If ActiveSheet.ProtectContents = False And ActiveSheet.Cells(2, 13).Value <> "BoQ_Ver2.0" Then
            MsgBox " Invalid BoQ!!! Please download the BoQ from the Downloads section of eProc Portal" & Chr(13)
        ElseIf ActiveSheet.ProtectContents = True And ActiveSheet.Cells(2, 13).Value = "BoQ_Ver2.0" And ActiveSheet.Cells(3, 13).Value <> "Yes" Then
            ActiveSheet.Cells(3, 13).Value = " "
            MsgBox "Warning ! Some issues are found in the BoQ, Please unprotect and Correct the issues", vbCritical, "GePNIC BoQ Validation"
        ElseIf ActiveSheet.ProtectContents = False And ActiveSheet.Cells(2, 13).Value = "BoQ_Ver2.0" And ActiveSheet.Cells(3, 13).Value = "Yes" Then
            ActiveSheet.Cells(3, 13).Value = " "
        End If
        
        If ActiveSheet.Cells(2, 13).Value = "BoQ_Ver2.0" And ActiveSheet.ProtectContents = False And ActiveSheet.Cells(3, 13).Value <> "Yes" Then
           ActiveSheet.Cells(3, 13).Value = " "
        
        c = 0
        Range("A8:G" & LastRow).Interior.ColorIndex = xlNone
         
        'Check all the items in the spreadsheet
        LLoop = 8
        While LLoop <= LastRow - 3
            LChangedValue = "A" & CStr(LLoop)
            If Len(Range(LChangedValue).Value) > 0 Then
                'Test each value for uniqueness
                LTestLoop = 2
                While LTestLoop <= LastRow - 3
                    If LLoop <> LTestLoop Then
                        LTestValue = "A" & CStr(LTestLoop)
                        'Value has been duplicated in another cell
                        If Range(LChangedValue).Value = Range(LTestValue).Value Then
                        'Set the background color to red
                                Range(LChangedValue).Interior.ColorIndex = 3
                                Range(LTestValue).Interior.ColorIndex = 3
                            msgdup = "0. Please remove duplicate S.Nos highlight in Background Color" & Chr(13)
                        End If
                    End If
                    LTestLoop = LTestLoop + 1
                Wend
            End If
            LLoop = LLoop + 1
        Wend
        
        For i = 8 To intRowCount
            msg1 = ""
            If ActiveSheet.Cells(i, 1).NumberFormat <> "0.00" Then
                c = c + 1
                msg1 = c & ". Please assign S.No in Number format for the S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 1).Interior.ColorIndex = 3
            ElseIf Not IsNumeric(ActiveSheet.Cells(i, 3).Value) Or Not IsNumeric(ActiveSheet.Cells(i, 5).Value) Or Not IsNumeric(ActiveSheet.Cells(i, 7).Value) Then
                    MsgBox "Please Enter Valid Data for Numeric Columns for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                    End
            ElseIf ActiveSheet.Cells(i, 1).Value = vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please enter the S.No for the description ' " & ActiveSheet.Cells(i, 2) & " '" & Chr(13)
                ActiveSheet.Cells(i, 1).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 2).Value = vbNullString And ActiveSheet.Cells(i, 1).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please enter the Item Description for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 2).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 3).NumberFormat <> "0.00" And ActiveSheet.Cells(i, 1).Value <> vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString And ActiveSheet.Cells(i, 4).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Format Error!! Please assign the Quantity in Number format for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 3).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 3).Value = vbNullString And ActiveSheet.Cells(i, 1).Value <> vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString And ActiveSheet.Cells(i, 4).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please enter the Quantity for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 3).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 3).Value < 0.01 And ActiveSheet.Cells(i, 1).Value <> vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString And ActiveSheet.Cells(i, 4).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please enter the Quantity greater than or equal to one for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 3).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 4).Value = vbNullString And ActiveSheet.Cells(i, 1).Value <> vbNullString And ActiveSheet.Cells(i, 2).Value <> vbNullString And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please enter the Units for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 4).Interior.ColorIndex = 3
            
            ElseIf ActiveSheet.Cells(i, 5).NumberFormat <> "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please assign the valid Estimated Rate format for S.No  " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 5).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 5).Value <> "" And ActiveSheet.Cells(i, 3).Value = vbNullString Then
                c = c + 1
                msg1 = c & ". Please remove the Estimated Rate format for S.No  " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 5).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 5).Value = "" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please Enter the Estimated Rate format for S.No  " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 5).Interior.ColorIndex = 3
                
            ElseIf Left(ActiveSheet.Cells(i, 6).Value, 6) = "#VALUE!" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please Enter the Estimate Rate or Remove the formula for Amount in Words for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 6).Interior.ColorIndex = 3
            ElseIf Left(ActiveSheet.Cells(i, 6).Value, 6) <> "Rupees" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please Enter the Estimate Rate or Remove the formula for Amount in Words for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 6).Interior.ColorIndex = 3
            ElseIf Left(ActiveSheet.Cells(i, 6).Value, 6) = "Rupees" And ActiveSheet.Cells(i, 3).Value = vbNullString Then
                c = c + 1
                msg1 = c & ". Please remove the Amount in Words formula for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 6).Interior.ColorIndex = 3
        
            ElseIf ActiveSheet.Cells(i, 7).NumberFormat <> "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                c = c + 1
                msg1 = c & ". Please assign the Amount in Number format for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 7).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 7).NumberFormat = "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString And ActiveSheet.Cells(i, 7).Locked = False Then
                c = c + 1
                msg1 = c & ". Please protect the Amount Cell for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 7).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 7).Value = "" And ActiveSheet.Cells(i, 7).NumberFormat = "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString And ActiveSheet.Cells(i, 8).Locked = True Then
                c = c + 1
                msg1 = c & ". Please fix the valid formula for Amount Cell for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 7).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 7).Value <> "" And ActiveSheet.Cells(i, 3).Value = vbNullString Then
                c = c + 1
                msg1 = c & ". Please remove the Amount formula for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
                ActiveSheet.Cells(i, 7).Interior.ColorIndex = 3
            ElseIf ActiveSheet.Cells(i, 7).Value = 0 And ActiveSheet.Cells(i, 8).NumberFormat <> "0.00" And ActiveSheet.Cells(i, 3).Value <> vbNullString Then
                    c = c + 1
                    msg1 = c & ". Please fix the rate or assign the Amount in Number format for S.No " & ActiveSheet.Cells(i, 1) & Chr(13)
            End If
         
            msg = msg + "" + msg1
        Next i
                        
            If ActiveSheet.Cells(1, 13).Value = vbNullString Then
                c = c + 1
                msg2 = c & ". Invalid BoQ!!! Please download the BoQ from the Downloads section of eProc Portal" & Chr(13)
                ActiveSheet.Cells(i, 13).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Name <> boqsheetname Then
                c = c + 1
                msg3 = c & ". BoQ Sheet Name Error !!! Excel Sheet should be named as " & boqsheetname & Chr(13)
            End If
            If ActiveSheet.Cells(1, 1).Value = vbNullString Then
                c = c + 1
                msg4 = c & ". Header Error! Please enter the 'Tender Inviting Authority Details' in Row No: 1 " & Chr(13)
                ActiveSheet.Cells(1, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(2, 1).Value = vbNullString Then
                c = c + 1
                msg5 = c & ". Header Error! Please enter the 'Name of the Work / Details' in Row No: 2 " & Chr(13)
                ActiveSheet.Cells(2, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(3, 1).Value = vbNullString Then
                c = c + 1
                msg6 = c & ". Header Error! Please enter the 'Contract No' in Row No: 3 " & Chr(13)
                ActiveSheet.Cells(3, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(4, 2).Value <> vbNullString Then
                c = c + 1
                msg7 = c & ". Header Error! Please remove the Bidder Name " & ActiveSheet.Cells(4, 2) & Chr(13)
                ActiveSheet.Cells(4, 2).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(4, 6).Value <> vbNullString Then
                c = c + 1
                msg8 = c & ". Please assign Empty Column and Remove the Quoted % Rate " & ActiveSheet.Cells(4, 6) & Chr(13)
                ActiveSheet.Cells(4, 6).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(5, 1).Value = vbNullString Then
                c = c + 1
                msg9 = c & ". Header Error! Please enter the 'SCHEDULE OF WORKS' in Row No: 5 " & Chr(13)
                ActiveSheet.Cells(5, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(LastRow, 1).Value <> "Quoted Rate in Words" Then
                c = c + 1
                msg10 = c & ". Last Row doesn't contains Quoted Rate in Words " & Chr(13)
                ActiveSheet.Cells(LastRow, 1).Interior.ColorIndex = 3
            End If
            
            If ActiveSheet.Cells(LastRow - 1, 1).Value <> "Quoted Amount" Then
                c = c + 1
                msg11 = c & ". Last but one row before doesn't contains Quoted Amount " & Chr(13)
                ActiveSheet.Cells(LastRow - 1, 1).Interior.ColorIndex = 3
            End If
            If ActiveSheet.Cells(LastRow - 2, 1).Value <> "Total Estimated Cost in Figures" Then
                c = c + 1
                msg12 = c & ". Last but two row before doesn't contains Total Estimated Cost in Figures " & Chr(13)
                ActiveSheet.Cells(LastRow - 2, 1).Interior.ColorIndex = 3
            End If

            If ActiveSheet.Cells(LastRow, 3).Value = "#VALUE!" Then
                c = c + 1
                msg13 = c & ". Please check the Amount columns for all the items " & Chr(13)
                ActiveSheet.Cells(LastRow, 3).Interior.ColorIndex = 3
            End If
            
            If Left(ActiveSheet.Cells(LastRow, 3).Value, 6) <> "Rupees" Then
                c = c + 1
                msg14 = c & ". Please assign the Quoted Rate in Words formula for Last Row " & Chr(13)
                ActiveSheet.Cells(LastRow, 3).Interior.ColorIndex = 3
            End If
            
            msg = msgdup + "" + msg + "" + msg2 & msg3 & msg4 & msg5 & msg6 & msg7 & msg8 & msg9 & msg10 & msg11 & msg12 & msg13 & msg14
            
            If msg <> "" Then
                If ActiveSheet.ProtectContents = True Then
                    MsgBox "Failure!!! Please unprotect the BoQ and Correct the errors"
                Else
…

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