Option Explicit
Sub MyModified()
Dim oOS As Worksheet
Dim strColHeadings As String
Dim varNDS_Data(), varREF_Data(), varOverlay_Data()
Dim lngST As Long, lngIndex As Long, lngFldIndex As Long, lngItemIndex As Long, lngRecordIndex As Long, lngNDSRowIndex As Long
Dim lngOSRow As Long, lngOSCol As Long
Dim strFileName As String
Dim bMatched As Boolean, bNoMatch As Boolean, bNoREFMatchCanx As Boolean, bNoREFMatchCopyID As Boolean, bFirstMatch As Boolean
Dim bDupRow As Boolean, bConcatenateDupSC As Boolean, bConcatenateDupLF As Boolean, bNoMultiMatches As Boolean
Dim bDelim As Boolean, strDelimiter As String
  lngST = Timer
  strColHeadings = "REF/Contol#|Ser. Nb|Document Type|Document Date|Classification|Title|Description|Has Attachments|File Name"
  bMatched = False
  'NDS_Options Note: Only one on the next line shoul be true
  bFirstMatch = True: bDupRow = False: bConcatenateDupSC = False: bConcatenateDupLF = False: bNoMultiMatches = False
  'REF_Options Note: Normally both on next line are Fallse.  Only one on the next line can be true
  bNoREFMatchCopyID = False: bNoREFMatchCanx = False
  strDelimiter = ";": If bConcatenateDupLF = True Then strDelimiter = vbCrLf
  On Error Resume Next
  Set oOS = Worksheets("OVERLAY")
  If Err.Number = 0 Then
    Application.DisplayAlerts = False
    oOS.Delete
    Application.DisplayAlerts = True
  End If
  On Error GoTo 0
  Set oOS = Worksheets.Add
  oOS.Name = "OVERLAY"
  DoEvents
  With Worksheets("NDS_SHEET")
    lngIndex = .Cells(Rows.count, "A").End(xlUp).Row
    If lngIndex = 4 Then Exit Sub 'There is no data in NDS_SHEET
    varNDS_Data = .Range("A5").Resize(lngIndex - 4, 8).Value
  End With
  With Worksheets("REF_SHEET")
    lngIndex = .Cells(Rows.count, "A").End(xlUp).Row
    If lngIndex = 1 Then Exit Sub 'There is no data in REF_SHEET
    varREF_Data = .Range("A2").Resize(lngIndex - 1, 2).Value
  End With
  ReDim varOverlay_Data(1 To UBound(varREF_Data, 1), 1 To 9)
  For lngIndex = 1 To UBound(varREF_Data, 1)
    bNoMatch = True
    bMatched = False
    For lngItemIndex = 1 To UBound(varNDS_Data, 1)
      If InStr(1, varREF_Data(lngIndex, 2), varNDS_Data(lngItemIndex, 8), vbTextCompare) > 0 Then
        bNoMatch = False
        If Not bMatched Then
          lngRecordIndex = lngRecordIndex + 1
          varOverlay_Data(lngRecordIndex, 1) = varREF_Data(lngIndex, 1)
          lngNDSRowIndex = lngItemIndex + 1
          For lngFldIndex = 1 To 8
            varOverlay_Data(lngRecordIndex, lngFldIndex + 1) = varNDS_Data(lngNDSRowIndex, lngFldIndex)
          Next lngFldIndex
          If bFirstMatch Then Exit For
          bMatched = True
        Else
          If Not bNoMultiMatches Then
            If bDupRow Then
              lngRecordIndex = lngRecordIndex + 1
              varOverlay_Data(lngRecordIndex, 1) = varREF_Data(lngIndex, 1)
              lngNDSRowIndex = lngItemIndex + 1
              For lngFldIndex = 1 To 8
                varOverlay_Data(lngRecordIndex, lngFldIndex + 1) = varNDS_Data(lngNDSRowIndex, lngFldIndex)
              Next lngFldIndex
            Else
              For lngFldIndex = 1 To 8
                varOverlay_Data(lngRecordIndex, lngFldIndex + 1) = varOverlay_Data(lngRecordIndex, lngFldIndex + 1) & strDelimiter & varNDS_Data(lngNDSRowIndex, lngFldIndex)
              Next lngFldIndex
            End If
          Else
            MsgBox "Overlay function canceled due to multiple match on REF_SHEET row: " & lngIndex + 1
            GoTo lbl_Exit
          End If
        End If
      End If
   Next lngItemIndex
   Select Case True
     Case bNoREFMatchCopyID And bNoMatch
       lngRecordIndex = lngRecordIndex + 1
       'varOverlay_Data(lngRecordIndex, 1) = varREF_Data(lngIndex, 1)
     Case bNoREFMatchCanx And bNoMatch
       MsgBox "Overlay function canceled due to no NDS match for REF_SHEET row: " & lngIndex
       Exit For
   End Select
  Next lngIndex
  If lngRecordIndex Then oOS.Range("A2").Resize(lngRecordIndex, 9).Value = varOverlay_Data
  With oOS
     .Range("A1").Resize(1, 9).Value = Split(strColHeadings, "|")
    DoEvents
    .Rows(1).Font.Bold = True
    .Rows(1).AutoFilter
    .Rows(1).Select
    .Application.ActiveWindow.SplitColumn = 1
    .Application.ActiveWindow.SplitRow = 1
    .Application.ActiveWindow.FreezePanes = True
    DoEvents
    With .UsedRange
      .WrapText = False
      .EntireColumn.AutoFit
      If .ColumnWidth > 60 Then .ColumnWidth = 60
    End With
    DoEvents
    lngOSRow = 2
    Do While Len(.Cells(lngOSRow, 2).Value) > 0
      lngOSCol = 2
      Do While Len(.Cells(1, lngOSCol).Value) > 0
        .Cells(lngOSRow, lngOSCol).FormulaR1C1 = .Cells(lngOSRow, lngOSCol).Value
        lngOSCol = lngOSCol + 1
      Loop
      lngOSRow = lngOSRow + 1
    Loop
    .UsedRange.Columns.AutoFit
    .UsedRange.Rows.AutoFit
    DoEvents
    If bDupRow Then
      With .Columns(1)
        .FormatConditions.AddUniqueValues
        .FormatConditions(.FormatConditions.count).SetFirstPriority
        With .FormatConditions(1)
          .DupeUnique = xlDuplicate
          .Font.Color = -16383844
          .Font.TintAndShade = 0
          .Interior.PatternColorIndex = xlAutomatic
          .Interior.Color = 13551615
          .Interior.TintAndShade = 0
          .StopIfTrue = False
        End With
      End With
    End If
  End With
  MsgBox Timer - lngST
lbl_Exit:
  Set oOS = Nothing
  Exit Sub
lbl_Canx:
  Application.DisplayAlerts = False
  oOS.Delete
  Application.DisplayAlerts = True
  GoTo lbl_Exit
End Sub