Malicious Office (OOXML) — malware analysis report

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)
    
    Dim lngStatus   As Long
    
    lngStatus = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Call pDefaultView
    Application.EnableEvents = False
    On Error Resume Next
    ThisWorkbook.Save
    On Error GoTo 0: On Error GoTo -1: Err.Clear
    Application.EnableEvents = True
    ThisWorkbook.Saved = True
    
    Application.ScreenUpdating = lngStatus
    lngStatus = Empty
    
End Sub
Private Sub Workbook_Open()
    
    Dim lngStatus   As Long

    lngStatus = Application.ScreenUpdating
    Application.ScreenUpdating = False
    
    If Application.Version < 12 Then
        MsgBox "This version of MS-Excel is not supported for filling this sheet. This sheet can be opened and run on MS-Excel 2007 version onwards.", vbInformation, "Excel Version"
        GoTo ext:
    End If
    
    If Application.Version >= 15 Then
        Application.PrintCommunication = False
    End If
    On Error Resume Next
    Set frmMainForm = VBA.UserForms.Add("frmProgressBar")
    On Error GoTo 0: On Error GoTo -1: Err.Clear
    If Not frmMainForm Is Nothing Then
        frmMainForm.Tag = "ContentSheetInitialised"
        frmBackground.Show
    Else
        MsgBox "There is some memory issue with Excel Application. " & vbCrLf & _
        "Kindly close all excel files and reopen the content sheet to do listing.", vbInformation + vbOKOnly, "Excel Memory Issue"
    End If
    AppActivate Application.Caption
    If Application.Version >= 15 Then
        Application.PrintCommunication = True
    End If
ext:
    Application.ScreenUpdating = lngStatus
    lngStatus = Empty

End Sub

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
Option Explicit
Private Sub Worksheet_Activate()
    With ThisWorkbook.Worksheets("Welcome")
        .Range("A1").Select
    End With
    ActiveWindow.DisplayGridlines = False
    ActiveWindow.DisplayHeadings = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Dim lngStatus                       As Long
    
    Dim wks As Worksheet
    Set wks = ActiveSheet

    If Target.Cells.Count = 1 Then
        If Target.Row >= 9 And Target.Column = 1 And Target.Interior.Color <> RGB(191, 191, 191) Then
            lngStatus = Application.ScreenUpdating
            Application.ScreenUpdating = False
            If Left(Target.Value, 1) = "L" Then '"£" '29 Jan 19
                Target.Value = "R" & Right(Target.Value, Len(Target.Value) - 1)
                Call pFormattingSheetName(Target)
            ElseIf Left(Target.Value, 1) = "R" Then
                Target.Value = "L" & Right(Target.Value, Len(Target.Value) - 1) '"£" '29 Jan 19
                Call pFormattingSheetName(Target)
            End If
            Application.ScreenUpdating = lngStatus
        ElseIf Target.Address = Me.Range("COST").Address Then
        End If
    End If

End Sub


Attribute VB_Name = "Sheet13"
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
Option Explicit


Attribute VB_Name = "Sheet23"
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
Option Explicit


Attribute VB_Name = "modAddDeleteSheets"
'Name             : Global_Variables
'Type             : Standard Module
'Description      : This module contai globally declared variables used in project
Option Explicit
Public Sub pAdd_New_Product_Click()

    Dim strCategory_val                 As String
    Dim strSubCat_Val                   As String
    Dim strPrd_typ_val                  As String
    Dim strCost_val                     As String
    Dim strBrand_Val                    As String
    Dim strPath                         As String
    Dim strErrorMsg                     As String
    Dim strProductId                    As String
    Dim dblProgressBar                  As Double
    Dim blnSubCatMsg                    As Boolean
    Dim blnCheckSheetExist              As Boolean
    Dim blnCostValueEmpty               As Boolean
    Dim intMissingIndex                 As Long
    Dim lngStatus                       As Long

    lngStatus = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    With ThisWorkbook.Worksheets("Home")
        If .Shapes("shpDownloadUpdate").Visible Then
            Call pUpdateProgressStatus("Check Bulk Sheet Basic Setting(s)...", 0.05, "Adding New Product. Please wait...")
            Call pCheck_version
            GoTo EndPoint
        End If
    End With
    
    If fGetAddedProductsCount < 15 Then
        With ThisWorkbook.Worksheets("Welcome")
            strSubCat_Val = .Range("SUBCAT").Value
            strCategory_val = .Range("CAT").Value
            strPrd_typ_val = .Range("prd_type").Value
            strBrand_Val = .Range("SelectedBrand").Value
            If strSubCat_Val = vbNullString Or strCategory_val = vbNullString Or strPrd_typ_val = vbNullString Then
                GoTo EndPoint
            End If
            strCost_val = .Range("COST").Value
            Call protect_unprotect(False)
            If strCost_val = vbNullString Then
                blnCostValueEmpty = True
                On Error Resume Next
                strCost_val = Split(.Range("COST").Validation.Formula1, ",")(0)
                If strCost_val = vbNullString Then strCost_val = "Selling Price Based"
                .Range("COST").Value = strCost_val
                On Error GoTo 0: On Error GoTo -1: Err.Clear
            End If
            strPath = strSubCat_Val & gc_strSeperator & strCategory_val & "_db.xlsx"
        End With
        If IsInternetConnected() = False Then
            MsgBox "Please connect the internet to upgrade the content guidelines.", vbCritical, "Connection Error"
        Else
            If DateValue(ThisWorkbook.Worksheets("SystemFields").Cells(1, 100).Value) <> DateValue(Now()) Then ' 14 Jun 18
                Call pUpdateProgressStatus("Update Content Sheet System Setting(s)...", 0.1)
                Call pUpdateSystemList
            End If
            Call pUpdateProgressStatus("Update " & strPrd_typ_val & " Definition(s)...", 0.2, "Adding " & strPrd_typ_val & ". Please wait...")
            strProductId = fGetProductID(strCategory_val, strSubCat_Val, strPrd_typ_val)
            If strProductId <> "" Then
                Call pUpdateProgressStatus("Update " & strPrd_typ_val & " Help File(s)...", 0.3)
                Call pDownloadLatestGuidelines(strProductId)
                Call pUpdateProgressStatus("Update " & strPrd_typ_val & " DropDown value(s)...", 0.35)
                Call pUpdateMLFieldDropdownValues(strCategory_val, strSubCat_Val, strPrd_typ_val, strProductId)
            End If
            Call pUpdateProgressStatus("Update Costing Definition(s)...", 0.4)
        End If
        Call pUpdateProgressStatus("Preparing Sheets With Latest Definition(s)...", 0.5)
        dblProgressBar = pAdd_new_sheet_given_subcat(strCategory_val, strSubCat_Val, strPrd_typ_val, strBrand_Val, strCost_val, , blnSubCatMsg, 0.5)
        Call protect_unprotect(True)
        strProductId = fGetProductID(strCategory_val, strSubCat_Val, strPrd_typ_val)
        If strPrd_typ_val <> "" And strProductId = "" Then
            MsgBox "Some technical error occurred." & vbCrLf & strPrd_typ_val & " content guidelines for category is not available" & vbCrLf & _
                   "Please try after some time", vbInformation, "Add Listing Sheets"
            With ThisWorkbook.Worksheets("Welcome")
                .Activate
                .Range("A1").Select
            End With
        Else
            Call pUpdateProgressStatus("Adding Costing Definition(s)...", dblProgressBar + 0.05, "Successfully Added " & strPrd_typ_val & " !")
            'Call pWeightCorrectionLimit(Left(strPrd_typ_val, 27 - Len(strProductId) - 4) & Left(strBrand_Val, 4) & "_" & strProductId) '3 Dec 19
            'Call pDeadWeightLimit(Left(strPrd_typ_val, 27 - Len(strProductId) - 4) & Left(strBrand_Val, 4) & "_" & strProductId) '3 Dec 19
            Call pUpdateProgressStatus("Adding Costing Definition(s)...", dblProgressBar + 0.1)
            Call pSLAValidation_From_Shield(Left(strPrd_typ_val, 27 - Len(strProductId) - 4) & Left(strBrand_Val, 4) & "_" & strProductId)
            If strPrd_typ_val <> "" Then
                With ThisWorkbook.Worksheets(Left(strPrd_typ_val, 27 - Len(strProductId) - 4) & Left(strBrand_Val, 4) & "_" & strProductId)
                    .Activate
                    .Range("A1").Select
                End With
            End If
        End If
    Else
        MsgBox "You have reached the maximum limit of listing sheets" & vbCrLf & "Please delete some listing sheets in order to proceed" _
               , vbInformation + vbOKOnly, "Add Listing Sheets"
    End If

EndPoint:
    Call pUpdateProgressStatus("Adding Costing Definition(s)...", dblProgressBar + 0.16)
    Call pResetFind
    If blnCostValueEmpty Then ThisWorkbook.Worksheets("Welcome").Range("COST").ClearContents

    strSubCat_Val = vbNullString
    strPrd_typ_val = vbNullString
    strCost_val = vbNullString
    strCategory_val = vbNullString
    strPath = vbNullString
    strErrorMsg = vbNullString
    intMissingIndex = Empty
    blnCheckSheetExist = Empty
    blnCostValueEmpty = Empty
    blnSubCatMsg = Empty
    
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = lngStatus
    lngStatus = Empty
    
End Sub
Public Function pAdd_new_sheet_given_subcat(strCategory_val As String, strSubCat_Val As String, strPrd_typ_val As String, strBrand_Val As String, strCost_val As String, Optional blnMessage As Boolean = True, Optional blnSubCatMsg As Boolean = True, Optional dblUpdatePerct As Double, Optional blnReAppy As Boolean) As Double

    Dim rngCell                         As Range
    Dim rngPointer                      As Range
    Dim strProductId                    As String
    Dim is_filter                       As String
    Dim strVal_Type                     As String
    Dim strMandatory                    As String
    Dim strFree_txt                     As String
    Dim strFormula                      As String
    Dim field_name                      As String
    Dim len_rng                         As String
    Dim strURL                          As String
    Dim strCostingType                  As String
    Dim dblRndColor                     As Double
    Dim prd_id1                         As String
    Dim lngStatus                       As Long
    Dim LC                              As Long
    Dim i                               As Long
    Dim lastcolofFirstrow               As Long
    Dim colofField                      As Long
    Dim colofUrl                        As Long
    Dim colofCat                        As Long
    Dim colofValues                     As Long
    Dim colofType                       As Long
    Dim colofmax_len                    As Long
    Dim colofFree_Text                  As Long
    Dim colofInvaild                    As Long
    Dim colofFieldLogical               As Long
    Dim colofFilter                     As Long
    Dim colofRange                      As Long
    Dim colofMandatory                  As Long
    Dim colofBrandName                  As Long
    Dim lastrow                         As Long
    Dim colofMultipleselection          As Long
    Dim colofFieldType                  As Long
    Dim lngFieldHelprow                 As Long
    Dim cell_val                        As String
    Dim blnCSSheetExist                 As Boolean
    Dim blnNewSheetsAdded               As Boolean
    Dim blnIGSheetExist                 As Boolean
    Dim blnIMGInArray                   As Boolean
    Dim colofVariant                    As Long
    Dim field_Variant                   As Long
    
    lngStatus = Application.ScreenUpdating
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    Call protect_unprotect(False)    ''SHEET UNPROTECT

    prd_id1 = fGetProductID(strCategory_val, strSubCat_Val, strPrd_typ_val)

    If prd_id1 = vbNullString Then
        If blnSubCatMsg = True Then
            MsgBox strPrd_typ_val & " is not available within " & strSubCat_Val & vbCrLf & vbCrLf & "Please contact snapdeal to update this", vbInformation, "Add Listing Sheets"
        End If
        GoTo ExitPoint
    End If
    strProductId = Left(strPrd_typ_val, 27 - Len(prd_id1) - 4) & Left(strBrand_Val, 4) & "_" & prd_id1
    dblRndColor = Int((50 * Rnd()) + 1)
    
    If strProductId <> "" Then
        Call fGetSellerType_FromSIS
        Call fGetSellerType_FromComs '10 Oct 17
        If find_sheet_exists(strProductId) = False Then
            With ThisWorkbook.Worksheets("Welcome")
                .Unprotect gc_strWksPassword
                .Range("$C$5:$F$5").ClearContents
                .Shapes("grpSearch").GroupItems("txtSearch").TextFrame.Characters.Text = "Click here to search category, subcategory and product type"
                .Shapes("grpSearch").GroupItems("txtSearch").Fill.Forecolor.RGB = RGB(255, 255, 255)
                .Protect gc_strWksPassword
            End With
            Call pAddNewProductSheet(strProductId, strBrand_Val, dblRndColor)
            Call pPrepare_Image_sheet(strProductId)
            Call pDownloadSizeChart(strSubCat_Val & "_" & strCategory_val & "_sizechart.xlsx", strSubCat_Val, strCategory_val, strProductId)
            Call pDownloadSizeChartTemplate(strSubCat_Val & "_" & strCategory_val & "_sizechart_template.xlsx", strSubCat_Val, strCategory_val, strProductId)
            Call pDownloadFieldHelpMapping(prd_id1)
            With ThisWorkbook.Worksheets("database")
                lastcolofFirstrow = FindLastCol(.Rows("1:1"))
                colofUrl = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "URL").Column
                Set rngCell = find_cell_in_range(.Range("A:F"), prd_id1)
                If rngCell Is Nothing Then
                    MsgBox ("Data Mismatch Error")
                    GoTo ExitPoint
                End If
                strURL = .Cells(rngCell.Row, colofUrl).Value
            End With
            If strCost_val <> "" Then
                Call pPrepare_Costing_sheet(strURL, strProductId, strCost_val)
                blnCSSheetExist = find_sheet_exists("CS-" & strProductId)
            End If
            Call pAddNavigationShapes(strProductId)
            blnNewSheetsAdded = True
        Else
            blnCSSheetExist = find_sheet_exists("CS-" & strProductId)
            If blnMessage = True Then
                Call pUpdateProgressStatus("Added Product,Cost and Image Sheet Re-validating...", dblUpdatePerct + 0.08)
                MsgBox "You have already added " & strProductId & " listing", vbCritical, "Add Listing Sheets"
            End If
        End If
        
        blnIGSheetExist = find_sheet_exists("IG-" & strProductId)
        If blnReAppy = True Then ' 24 Apr
            Dim lngFlagVal As Long
            Dim strBname As String
            lngFlagVal = ThisWorkbook.Worksheets(strProductId).Range("SJ1").Value
            strBname = ThisWorkbook.Worksheets(strProductId).Range("SK1").Value
        Else
            Call pSetBrandString(strProductId)
            If gc_sellerFlag = True Then 'Oct 17
                Call pProductIDFound(strProductId)
            End If
        End If
        Call pClearExtraRows(strProductId)    'Clear all rows after the allowed rows
        Call pUpdateRowLimit(strProductId)    'Update next row just after last allowed row on all sheets for restriction
        If blnReAppy = True Then ' 26 Apr
            Dim lngSts  As Long
            lngSts = Application.EnableEvents
            Application.EnableEvents = False ' 23 Jul 18
            ThisWorkbook.Worksheets(strProductId).Range("SJ1").Value = lngFlagVal
            ThisWorkbook.Worksheets(strProductId).Range("SK1").Value = strBname
            Application.EnableEvents = lngSts
        End If
        Call pApplyFixedHeaders(strProductId, blnMessage)
        Call pUpdateProgressStatus("New Definitions Found and Applying for " & strPrd_typ_val & "...", dblUpdatePerct + 0.04)
        With ThisWorkbook.Worksheets("database")
            lastcolofFirstrow = FindLastCol(.Rows("1:1"))    'GET LAST COLUMN IN db
            colofField = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Field Name").Column
            colofFieldLogical = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Field Logical Name").Column
            colofUrl = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "URL").Column
            colofCat = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Category").Column
            colofValues = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Values").Column
            colofType = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Data Type").Column
            colofmax_len = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Maximum Length").Column
            colofFree_Text = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Free Text Allowed").Column
            colofInvaild = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Invalid Character Set").Column
            colofFilter = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Filter").Column
            colofRange = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Range").Column
            colofVariant = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Variant").Column
            colofMandatory = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "MANDATORY").Column
            lastrow = FindLastRow(.Range("A:" & convertcolu(lastcolofFirstrow)))
            colofMultipleselection = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Multiple Selection").Column
            colofBrandName = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "BrandName").Column
            'GET LAST ROW
            colofValues = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Values").Column
            colofFieldType = find_cell_in_range(.Range(.Cells(1, 1), .Cells(1, lastcolofFirstrow)), "Field Type").Column
            Set rngCell = find_cell_in_range(.Range("A:F"), prd_id1)
            If rngCell Is Nothing Then
                MsgBox ("Data Mismatch Error")
                GoTo ExitPoint
            End If
        End With
        Call pUpdateProgressStatus("Applying Common Definition(s) for " & strPrd_typ_val & "...", dblUpdatePerct + 0.08)
        Call pExtravalidation_main(ThisWorkbook.Worksheets(strProductId))
        If blnReAppy = False Then '23 Jul 18
            Set rngPointer = fApplySystemFieldsValidation(colofFieldType, colofType, colofMandatory, colofFree_Text, colofFilter, _
                                                      colofValues, colofRange, colofmax_len, colofField, colofInvaild, colofMultipleselection, colofFieldLogical, strProductId)
        End If
        If blnCSSheetExist And blnReAppy = False Then '23 Jul 18
            Call fApplySystemFieldsValidationCosting(colofFieldType, colofType, colofMandatory, colofFree_Text, colofFilter, _
                                                     colofValues, colofRange, colofmax_len, colofField, colofInvaild, colofMultipleselection, "CS-" & strProductId)
        End If

        Dim field_type                  As String
        Dim inv                         As String
        Dim multiple_selection          As String
        Application.EnableEvents = False
        
        ThisWorkbook.Worksheets(strProductId).Unprotect gc_strWksPassword
        Dim varSplitBrand As Variant ' 24 Apr
        Dim lngBrand    As Long
        Dim blnTempBnd  As Boolean
        varSplitBrand = Split(ThisWorkbook.Worksheets(strProductId).Range("ALP1").Value, ",")
        If ThisWorkbook.Worksheets(strProductId).Range("C3").Value <> "" Then
            For lngBrand = LBound(varSplitBrand) To UBound(varSplitBrand)
                If UCase(varSplitBrand(lngBrand)) = UCase("""" & ThisWorkbook.Worksheets(strProductId).Range("C3").Value & """") Then
                    strBrand_Val = Replace(varSplitBrand(lngBrand), """", "")
                    blnTempBnd = True
                    Exit For
                End If
            Next lngBrand ' 24 Apr
        End If

        While StrComp(rngCell.Value, prd_id1, vbTextCompare) = 0 And StrComp(rngCell.Parent.Cells(rngCell.Row, colofBrandName).Value, strBrand_Val, vbTextCompare) <> 0
            Set rngCell = rngCell.Offset(1, 0)
        Wend
        Call pUpdateProgressStatus("Apply Category Specific Definition(s)...", dblUpdatePerct + 0.16)
        While StrComp(rngCell.Value, prd_id1, vbTextCompare) = 0 And StrComp(rngCell.Parent.Cells(rngCell.Row, colofBrandName).Value, strBrand_Val, vbTextCompare) = 0
            With ThisWorkbook.Worksheets("database")
                field_type = .Cells(rngCell.Row, colofFieldType).Value
                field_name = .Cells(rngCell.Row, colofField).Value
                If UCase(field_name) = "PRODUCT IDENTIFIER" Or UCase(field_name) = "OFFER GROUP NAME" Then GoTo SkipWhile 'Or UCase(field_name) = "PRODUCT TYPE" Then GoTo SkipWhile
                inv = .Cells(rngCell.Row, colofInvaild).Value
                multiple_selection = .Cells(rngCell.Row, colofMultipleselection).Value
                
                If UCase(multiple_selection) <> "N" Then
                    Dim lngFieldCol     As Long
                    Dim strParentCol    As String
                    With ThisWorkbook.Worksheets(strProductId)
                        If UCase(multiple_selection) = "Y" Then
                            lngFieldCol = rngPointer.Column
                            rngPointer.Parent.Unprotect gc_strWksPassword
                            rngPointer.Offset(-1, intOffsetColumn + 100).ClearComments
                            rngPointer.Offset(-1, intOffsetColumn + 100).AddComment rngCell.Row & ""
                        Else
                            lngFieldCol = fGetColumn(.Range(.Range("B2"), .Range("B2").End(xlToRight)), multiple_selection)
                        End If
                    End With
                    If lngFieldCol > 0 Then
                        If inv = vbNullString Then
                            inv = "MUL_SEL"
                        Else
                            inv = inv & "," & "MUL_SEL"
                        End If
                        strParentCol = multiple_selection
                    Else
                        strParentCol = vbNullString
                    End If
                Else
                    strParentCol = vbNullString
                End If
                ''
                blnIMGInArray = get_IsInArray(field_name, "IMAGE")
                If StrComp(field_type, "CAT", vbTextCompare) = 0 And blnIMGInArray = False Then
                    Dim COL_FLAG        As Boolean
                    With ThisWorkbook.Worksheets(strProductId)
                        If get_IsInArray(field_name, "CAT", strProductId) Then
                            COL_FLAG = True
                            Set rngPointer = .Rows("2:2").Find(What:=field_name, LookIn:=xlFormulas, _
                                                               LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                                                               MatchCase:=False, SearchFormat:=False)
                        Else
                            COL_FLAG = False
                        End If
                    End With

                    Dim rngPointer_val  As String
                    rngPointer.Parent.Unprotect gc_strWksPassword
                    rngPointer_val = Replace(UCase(rngPointer.Value), " ", "")
                    rngPointer.Offset(-1, intOffsetColumn).ClearComments
                    rngPointer.Offset(-1, intOffsetColumn).AddComment (":" & inv)
                    rngPointer.Offset(0, intOffsetColumn).ClearComments
                    rngPointer.Offset(0, intOffsetColumn).AddComment (.Cells(rngCell.Row, colofFieldLogical).Value)
                    With ThisWorkbook.Worksheets("Database")
                        strVal_Type = .Cells(rngCell.Row, colofType).Value
                        strMandatory = .Cells(rngCell.Row, colofMandatory).Value
                        field_Variant = .Cells(rngCell.Row, colofVariant).Value
                        strFree_txt = .Cells(rngCell.Row, colofFree_Text).Value
                        If field_Variant = 1 Then
                            If rngPointer.Parent.Shapes("shpNavigator").AlternativeText = "" Then
                                rngPointer.Parent.Shapes("shpNavigator").AlternativeText = "variant"
                            End If
                            With rngPointer.Offset(1, 0).Resize(intUsedRow)
                                .Interior.Color = RGB(242, 220, 219)
                                With .Borders(xlInsideHorizontal)
                                    .LineStyle = xlContinuous
                                    .Color = RGB(218, 220, 221)
                                    .TintAndShade = 0
                                    .Weight = xlThin
                                End With
                            End With
                        End If
                        is_filter = "N"
                        If .Cells(rngCell.Row, colofValues).Value <> "" Then
                            is_filter = "Y"
                        End If
                        If .Cells(rngCell.Row, colofValues).Comment Is Nothing Then
                            strFormula = .Cells(rngCell.Row, colofValues).Value
                        Else
                            strFormula = .Cells(rngCell.Row, colofValues).Value & .Cells(rngCell.Row, colofValues).Comment.Text
                            Dim lngNextCol As Long
                            lngNextCol = 1
                            While Not .Cells(rngCell.Row, colofValues + lngNextCol).Comment Is Nothing
                                strFormula = strFormula & .Cells(rngCell.Row, colofValues + lngNextCol).Comment.Text
                                lngNextCol = lngNextCol + 1
                            Wend
                        End If
                        If UCase(strVal_Type) = "NUMERIC" Or UCase(strVal_Type) = "INTEGER" Or UCase(strVal_Type) = "LONG" Or UCase(strVal_Type) = "DOUBLE" Then
                            len_rng = .Cells(rngCell.Row, colofRange).Value
                        Else
                            len_rng = .Cells(rngCell.Row, colofmax_len).Value
                        End If
                    End With
                    Call pApplyValidation(is_filter, rngPointer, strVal_Type, field_name, _
                                          strFormula, len_rng, strMandatory, strFree_txt, strParentCol)
                    Application.EnableEvents = False
                    If COL_FLAG = False Then
                        ThisWorkbook.Worksheets("fixed-headers").Cells(1, 1).Copy
                        rngPointer.PasteSpecial Paste:=xlFormats
                        Application.CutCopyMode = False
                    End If
                    rngPointer.Parent.Unprotect gc_strWksPassword
                    rngPointer.Value = rngCell.Offset(0, colofField - rngCell.Column).Value
                    rngPointer.HorizontalAlignment = xlCenter
                    If UCase(strMandatory) = "Y" Or UCase(strMandatory) = "M" Then
                        With rngPointer.Offset(-1, 0)
                            .Value = "Mandatory"
                            .Font.Color = RGB(192, 80, 77)
                            .Font.Bold = True
                        End With
                        rngPointer.Interior.Color = RGB(192, 80, 77)
                    ElseIf UCase(strMandatory) = "I" Then
                        With rngPointer.Offset(-1, 0)
                            .Value = "Important"
                            .Font.Color = RGB(96, 73, 122)
                            .Font.Bold = True
                        End With
                        rngPointer.Interior.Color = RGB(96, 73, 122)
                    ElseIf UCase(strMandatory) = "O" Then
                        With rngPointer.Offset(-1, 0)
                            .Value = "Optional"
                            .Font.Color = RGB(0, 112, 192)
                            .Font.Bold = True
                        End With
                        rngPointer.Interior.Color = RGB(0, 112, 192)
                    ElseIf UCase(strVal_Type) = "NUMERIC" Or UCase(strVal_Type) = "INTEGER" Or UCase(strVal_Type) = "LONG" Or UCase(strVal_Type) = "DOUBLE" Then
                        With rngPointer.Offset(-1, 0)
                            .Value = "Numeric"
                            .Font.Color = rngPointer.Interior.Color
                            .Font.Bold = True
                        End With
                    Else
                        With rngPointer.Offset(-1, 0)
                            .Value = "Product Highlight"
                            .Font.Color = rngPointer.Interior.Color
                            .Font.Bold = True
                        End With
                    End If
                    With rngPointer.Parent.Range("A1").EntireRow
                        .WrapText = False
                        .VerticalAlignment = xlBottom
                        .HorizontalAlignment = xlCenter
                    End With
                    lngFieldHelprow = fProductIDFoundFieldHelp(rngPointer, prd_id1)
                    If lngFieldHelprow > 1 Then
                        Call pAddHelpFieldShape(rngPointer, lngFieldHelprow)
                    End If
                    Set rngPointer = ThisWorkbook.Worksheets(strProductId).Cells(2, FindLastCol(ThisWorkbook.Worksheets(strProductId).Range("a2:df2")) + 1)
                ElseIf StrComp(field_type, "COST", vbTextCompare) = 0 And blnCSSheetExist = True Then   'if is COST Field
                    With ThisWorkbook.Worksheets("Database")
                        field_name = .Cells(rngCell.Row, colofField).Value
                        If get_IsInArray(field_name, "COST") Then
                            strVal_Type = .Cells(rngCell.Row, colofType).Value
                            strMandatory = .Cells(rngCell.Row, colofMandatory).Value
                            strFree_txt = .Cells(rngCell.Row, colofFree_Text).Value
                            is_filter = "N"
                            If .Cells(rngCell.Row, colofValues).Value <> "" Then
                                is_filter = "Y"
                            End If
                            strFormula = .Cells(rngCell.Row, colofValues).Value
                            If UCase(strVal_Type) = "NUMERIC" Or UCase(strVal_Type) = "LONG" Or UCase(strVal_Type) = "INTEGER" Or UCase(strVal_Type) = "DOUBLE" Then
                                len_rng = .Cells(rngCell.Row, colofRange).Value
                            Else
                                len_rng = .Cells(rngCell.Row, colofmax_len).Value
                            End If

                            With ThisWorkbook.Worksheets("CS-" & strProductId)
                                Dim rngPointer_cs As Range
                                .Unprotect gc_strWksPassword
                                Set rngPointer_cs = .Rows("2:2").Find(What:=field_name, LookAt:=xlWhole)
                                rngPointer_cs.Offset(-1, intOffsetColumn).ClearComments
                                rngPointer_cs.Offset(-1, intOffsetColumn).AddComment (":" & inv)
                                
                                Call pApplyValidation(is_filter, rngPointer_cs, strVal_Type, field_name, _
                                                      strFormula, len_rng, strMandatory, strFree_txt)
                                Application.EnableEvents = False
                                .Unprotect gc_strWksPassword
                                If UCase(ThisWorkbook.Worksheets("database").Cells(rngCell.Row, colofMandatory).Value) = "Y" Or _
                                UCase(ThisWorkbook.Worksheets("database").Cells(rngCell.Row, colofMandatory).Value) = "M" Then
                                    With rngPointer_cs.Offset(-1, 0)
                                        .Value = "Mandatory"
                                        .Font.Color = RGB(192, 80, 77)
                                        .Font.Bold = True
                                    End With
                                    rngPointer_cs.Interior.Color = RGB(192, 80, 77)
                                ElseIf UCase(strMandatory) = "I" Then
                                    With rngPointer_cs.Offset(-1, 0)
                                        .Value = "Important"
                                        .Font.Color = RGB(96, 73, 122)
                                        .Font.Bold = True
                                    End With
                                    rngPointer_cs.Interior.Color = RGB(96, 73, 122)
                                ElseIf UCase(strMandatory) = "O" Then
                                    With rngPointer_cs.Offset(-1, 0)
                                        .Value = "Optional"
                                        .Font.Color = RGB(0, 112, 192)
                                        .Font.Bold = True
                                    End With
                                    rngPointer_cs.Interior.Color = RGB(0, 112, 192)
                                ElseIf UCase(ThisWorkbook.Worksheets("database").Cells(rngCell.Row, colofType).Value) = "NUMERIC" Or UCase(ThisWorkbook.Worksheets("database").Cells(rngCell.Row, colofType).Value) = "LONG" Or UCase(ThisWorkbook.Worksheets("database").Cells(rngCell.Row, colofType).Value) = "INTEGER" Or UCase(ThisWorkbook.Worksheets("database").Cells(rngCell.Row, colofType).Value) = "DOUBLE" Then
                                    With rngPointer_cs.Offset(-1, 0)
                                        .Value = "Numeric"
                                        .Font.Color = RGB(192, 80, 77)
                                        .Font.Bold = True
                                    End With
                                    rngPointer_cs.Interior.Color = RGB(192, 80, 77)
                                Else
                                    With rngPointer_cs.Offset(-1, 0)
                                        .Value = "Product Highlight"
                                        .Font.Color = RGB(192, 80, 77)
                                        .Font.Bold = True
                                    End With
                                    rngPointer_cs.Interior.Color = RGB(192, 80, 77)
                                End If
                                ThisWorkbook.Worksheets("CS-" & strProductId).Protect gc_strWksPassword, AllowFormattingColumns:=True
                            End With
                        End If
                    End With
                ElseIf StrComp(field_type, "CAT", vbTextCompare) = 0 And blnIGSheetExist = True And blnIMGInArray Then
                    With ThisWorkbook.Worksheets("Database")
                        strMandatory = .Cells(rngCell.Row, colofMandatory).Value
                        If strMandatory = "Y" Or UCase(strMandatory) = "M" Then
                            Call pApplyImageValidation("IG-" & strProductId, field_name)
                        End If
                    End With
                End If
SkipWhile:
                Set rngCell = rngCell.Offset(1, 0)
            End With
        Wend
    End If
    
    If blnReAppy = False Then ' 24 Apr
        Call pUpdateProgressStatus("Applying Sheet Dimension(s) Setting(s) ...", dblUpdatePerct + 0.2)
        Call pSetColumnWidth(ThisWorkbook.Worksheets("CS-" & strProductId), "Error Check", 2, 15)
        With ThisWorkbook.Worksheets(strProductId)
            .Activate
            Call pSetProductIdentifier(prd_id1, colofFieldType, colofType, strVal_Type, colofMandatory, colofFree_Text _
                                  , colofFilter, colofValues, colofRange, colofmax_len, colofField, strProductId)
            If .Range("A2").Value = "" Then
                .Range("A2").EntireColumn.Hidden = True
            Else
                With .Range("A2")
                    .EntireColumn.Hidden = False
                    .Interior.Color = ThisWorkbook.Worksheets("fixed-headers").Range("rngNewHeaders").Interior.Color
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    With .Font
                        .Color = vbWhite
                        .Size = 11
                        .Name = "Arial"
                        .Bold = True
                    End With
                End With
                Call pApplyBordersNewHeader(.Range("A1:A2"))
            End If
            .Columns("D:DZ").AutoFit
            Dim rngColumn As Range
            For Each rngColumn In .Columns("D:DZ")
                If rngColumn.ColumnWidth > 50 Then
                    rngColumn.ColumnWidth = 50
                End If
            Next
            Set rngColumn = Nothing
            Call pAddCommentsShapesToProductSheets(strProductId)
            .Cells(1, 1).Parent.Activate
            .Cells(1, 1).Select
            .Protect gc_strWksPassword
        End With
        If blnTempBnd = True Then '24 Apr
            strBrand_Val = ""
        End If

        Call pSetColumnWidth(ThisWorkbook.Worksheets(strProductId), "Description", 2, 18)
        If blnNewSheetsAdded = True Then
            MsgBox "The following 3 sheets have been added for selected listing :" & vbCrLf & _
                   "1.  Product Sheet: Enter the product details here - " & strProductId & vbCrLf & _
                   "2.  Costing Sheet: Enter offer details like MRP and Selling price and get an estimate of your merchant cut." & vbCrLf & _
                   "3.  Image Sheet: Enter Image URLs in this sheet against each SKUs." & vbCrLf & vbCrLf & _
                   "Once the listing has been completed, you need to click on Export sheet and upload in the seller panel.", vbInformation + vbOKOnly, "Add Listing Sheets: " & strPrd_typ_val
        End If
        Call pUpdateProgressStatus("Applying Listing Indicators Setting(s) ...", dblUpdatePerct + 0.24)
        Call pSetPositionsShapes(strProductId, strPrd_typ_val, strBrand_Val, strCategory_val, strSubCat_Val)
        Call pApplyCreateGroupFormula(strProductId)
        If gc_sellerFlag = True Then Call pApplyandCreateProductFormula(ThisWorkbook.Worksheets(strProductId)) 'Oct 17
        ThisWorkbook.Worksheets("Welcome").Cells(1, 1002).ClearContents
        With ThisWorkbook.Worksheets("Welcome").Shapes("shpDeleteEnableListing")
            .Visible = False
            .Visible = False
            If fGetAddedProductsCount = 0 Then
                .Visible = True
            Else
                .Visible = True
            End If
        
        End With
    End If
ExitPoint:
    pAdd_new_sheet_given_subcat = dblUpdatePerct + 0.24
    
    Set rngPointer = Nothing
    Set rngCell = Nothing
    lngFieldCol = Empty
    lngNextCol = Empty
    colofCat = Empty
    colofUrl = Empty
    colofField = Empty
    colofFieldType = Empty
    colofFilter = Empty
    colofFree_Text = Empty
    colofInvaild = Empty
    colofMandatory = Empty
    colofmax_len = Empty
    colofMultipleselection = Empty
    colofRange = Empty
    colofType = Empty
    colofValues = Empty
    colofFieldLogical = Empty
    cell_val = vbNullString
    lastcolofFirstrow = Empty
    lastrow = Empty
    blnCSSheetExist = Empty
    blnNewSheetsAdded = Empty
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = lngStatus

End Function

Private Sub pAddNewProductSheet(strProductId As String, strBrandValue As String, dblRndColor As Double)

    Dim dblColor                        As Double
    Dim lngStatus                       As Long

    lngStatus = Application.ScreenUpdating
    Application.ScreenUpdating = False

    With ThisWorkbook
        With .Worksheets("Welcome").Cells(9, 1)
            dblColor = RGB(255, 255, 255)
            If .Value = "" Then
                .Value = strProductId
                .Interior.Color = dblColor
                .Value = "L" & .Value '"£ " 29 Jan 19
                Call pFormattingSheetName(ThisWorkbook.Worksheets("Welcome").Cells(9, 1))
            Else
                If .Offset(1, 0) = "" Then
                    .Offset(1, 0).Value = strProductId
                    .Offset(1, 0).Interior.Color = dblColor
                    .Offset(1, 0).Value = "L" & strProductId '"£ " 29 Jan 19
                    Call pFormattingSheetName(ThisWorkbook.Worksheets("Welcome").Cells(9, 1).Offset(1, 0))
                Else
                    .End(xlDown).Offset(1, 0).Value = strProductId
                    .End(xlDown).Offset(0, 0).Interior.Color = dblColor
                    .End(xlDown).Offset(0, 0).Value = "L" & strProductId '"£ " 29 Jan 19
                    Call pFormattingSheetName(.End(xlDown))
                End If

            End If
        End With
        
        .Worksheets("Parent").Copy After:=.Worksheets("Validation Log")
        ActiveSheet.Name = strProductId
        With .Worksheets(strProductId)
            .Tab.ColorIndex = dblRndColor
            .Unprotect gc_strWksPassword
            .Cells.Locked = True
            .Cells.FormulaHidden = False
            Application.EnableEvents = False
            .Cells(1, 500).Value = strBrandValue
            .Cells(3, 1).Resize(intUsedRow, 200).Locked = False
            .Range("A1").RowHeight = 110
            .Protect gc_strWksPassword
        End With
    End With
    Call pUpdateMappingToDefault(strProductId)
    
    dblColor = Empty
    Application.EnableEvents = True
    Application.ScreenUpdating = lngStatus
    lngStatus = Empty
    
End Sub

Private Function pApplyFixedHeaders(strProductId As String, blnMessage As Boolean) As Range
    
    Dim rngPointer                      As Range
    Dim rngUnion                        As Range
    Dim lngLastColumn                   As Long
    Dim lngCount                        As Long
    Dim strCell_val                     As String
    Dim strProductFormula               As String
    Dim lngStatus                       As Long
    Dim rngID                           As Range
    
    lngStatus = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    With ThisWorkbook.Worksheets("fixed-headers")
        lngLastColumn = .Range("A3").End(xlToRight).Column
        ThisWorkbook.Worksheets(strProductId).Unprotect gc_strWksPassword ' 6 Apr 18
        Set rngID = ThisWorkbook.Worksheets("WeightCorrection").Columns(200).Find(What:=CStr(Right(strProductId, 4)), _
                                                           LookAt:=xlWhole, _
                                                           MatchCase:=False)
        
        If Not rngID Is Nothing Then           ' 8 Nov 17
            .Range(.Cells(2, 1), .Cells(3, 4)).Copy ThisWorkbook.Worksheets(strProductId).Cells(1, 2)
            .Range(.Cells(2, 6), .Cells(3, lngLastColumn)).Copy ThisWorkbook.Worksheets(strProductId).Cells(1, 6)
        Else
            .Range(.Cells(2, 1), .Cells(3, lngLastColumn)).Copy ThisWorkbook.Worksheets(strProductId).Cells(1, 2)
        End If

        Application.CutCopyMode = False
        lngLastColumn = fFindLastFixedHeaderColumn(strProductId)
    End With
    With ThisWorkbook.Worksheets(strProductId)
        .Unprotect gc_strWksPassword
        Set rngPointer = .Cells(2, lngLastColumn + 1)
        For lngCount = lngLastColumn + 1 To intOffsetColumn
            strCell_val = Replace(UCase(.Cells(2, lngCount).Value), " ", "")
            If StrComp(strCell_val, "", vbTextCompare) <> 0 And _
               StrComp(strCell_val, "SIZECHARTID", vbTextCompare) <> 0 And _
               StrComp(strCell_val, "TECHSPECS", vbTextCompare) <> 0 And _
               StrComp(strCell_val, "FREEBIEID", vbTextCompare) <> 0 Then
                If rngUnion Is Nothing Then
                    Set rngUnion = Union(.Cells(2, lngCount), .Cells(1, lngCount))
                Else
                    Set rngUnion = Union(rngUnion, .Cells(2, lngCount), .Cells(1, lngCount))
                End If
            Else
                On Error Resume Next
                .Cells(3, lngCount).Resize(intUsedRow, 1).Validation.Delete
                On Error GoTo 0: On Error GoTo -1: Err.Clear
            End If
        Next
        Application.EnableEvents = False
        If ThisWorkbook.Worksheets("Welcome").Range("I1").Value = 0 Then 'Neha 21 Dec
            For lngCount = 1 To lngLastColumn
                If UCase(.Cells(2, lngCount).Value) = UCase(gc_strVariantField) Then
                    With .Cells(3, lngCount).Resize(intUsedRow, 1)
                        Dim rngPTID As Range ' 14 Jun 18
                        Dim rCell   As Range
                        With ThisWorkbook.Worksheets("CS-Template")
                            Set rngPTID = .Range("SF1:SF" & .Range("SF" & .Rows.Count).End(xlUp).Row)
                        End With
                        For Each rCell In rngPTID.Cells
                            If CStr(rCell.Value) = CStr(Right(strProductId, 4)) Or CStr(rCell.Value) = "All" Then
                                GoTo CG
                            End If
                        Next rCell
                        .Locked = True
                        .Interior.Color = ThisWorkbook.Worksheets("CS-" & strProductId).Cells(3, lngCount).Interior.Color
                        With .Borders(xlInsideHorizontal)
                            .LineStyle = xlContinuous
                            .Color = RGB(218, 220, 221)
                            .TintAndShade = 0
                            .Weight = xlThin
                        End With
                    End With
CG:
                    Exit For
                End If
            Next
        End If
        For lngCount = 1 To lngLastColumn
            If UCase(.Cells(2, lngCount).Value) = "BRAND" Then
                If .Cells(1, 500).Value <> vbNullString Then
                    With .Cells(3, lngCount)
                        .Locked = True
                        .EntireColumn.Hidden = True
                    End With
                End If
                Exit For
            End If
        Next
        For lngCount = 1 To lngLastColumn
            If UCase(.Cells(2, lngCount).Value) = "PRODUCT NAME" Then
                If .Cells(1, 502).Value <> vbNullString And InStr(1, .Cells(1, 502).Value, "Product_Name") = 0 And gc_sellerFlag = True Then 'Oct 17
                    With .Cells(3, lngCount).Resize(intUsedRow, 1)
                        .Formula = "='CS-Template'!$B$9&"""""
                        .Interior.Color = RGB(191, 191, 191)
                        .Locked = True
                        .FormulaHidden = True
                    End With
                End If
                Exit For
            End If
        Next
    End With
    Application.EnableEvents = True
    
    If Not rngUnion Is Nothing Then
        rngUnion.ClearContents
        On Error Resume Next
        With rngUnion
            .Resize(intUsedRow).Validation.Delete
            .Resize(intUsedRow).Cells(1, 1).Resize(2, .Columns.Count).Clear
        End With
        On Error GoTo 0: On Error GoTo -1: Err.Clear
    End If
    With ThisWorkbook.Worksheets(strProductId)
        .Protect gc_strWksPassword
    End With
    
    Set pApplyFixedHeaders = rngPointer
    Set rngPointer = Nothing
    Set rngUnion = Nothing
    Set rngID = Nothing
    lngCount = Empty
    lngLastColumn = Empty
    strCell_val = vbNullString
    Application.EnableEvents = True
    Application.ScreenUpdating = lngStatus
    lngStatus = Empty
    
End Function

Private Function fGetMatchedRange(strStringTocheck As String) As Range

    Dim rngMatchedRange                 As Range
    Dim rngMatchedRangeCS               As Range
    Dim rngMatchedRangeIG               As Range
    Dim lngFirstRow                     As Long
    Dim lngLastRow                      As Long
    Dim lngFirstRowCS                   As Long
    Dim lngLastRowCS                    As Long
    Dim lngFirstRowIG                   As Long
    Dim lngLastRowIG                    As Long
    Dim lngStatus                       As Long

    lngStatus = Application.ScreenUpdating
    Application.ScreenUpdating = False

    With ThisWorkbook.Worksheets("Validation Log")
        On Error Resume Next
        With .Columns(4)
            lngFirstRow = .Find(What:=strStringTocheck, LookAt:=xlWhole, MatchCase:=False).Row
            lngLastRow = .Find(What:=strStringTocheck, LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False).Row    'Returns 7
            lngFirstRowCS = .Find(What:="CS-" & strStringTocheck, LookAt:=xlWhole, MatchCase:=False).Row
            lngLastRowCS = .Find(What:="CS-" & strStringTocheck, LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False).Row  'Returns 7
            lngFirstRowIG = .Find(What:="IG-" & strStringTocheck, LookAt:=xlWhole, MatchCase:=False).Row
            lngLastRowIG = .Find(What:="IG-" & strStringTocheck, LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False).Row  'Returns 7
        End With
        Set rngMatchedRangeCS = .Range(.Cells(lngFirstRowCS, 4), .Cells(lngLastRowCS, 4))
        Set rngMatchedRange = .Range(.Cells(lngFirstRow, 4), .Cells(lngLastRow, 4))
        Set rngMatchedRangeIG = .Range(.Cells(lngFirstRowIG, 4), .Cells(lngLastRowIG, 4))
    End With
    On Error GoTo 0: On Error GoTo -1: Err.Clear
    If rngMatchedRangeIG Is Nothing Then
        If Not rngMatchedRange Is Nothing And Not rngMatchedRangeCS Is Nothing Then
            Set fGetMatchedRange = Application.Union(rngMatchedRange, rngMatchedRangeCS)
        ElseIf Not rngMatchedRange Is Nothing Then
            Set fGetMatchedRange = rngMatchedRange
        ElseIf Not rngMatchedRangeCS Is Nothing Then
            Set fGetMatchedRange = rngMatchedRangeCS
        End If
…