Application.DisplayAlerts = False not working for MergeCells

[Dad_x6]

I have a very large application (so large that I am not going to post all of my code).

On line 130 of the code, I have the following...

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .AskToUpdateLinks = False
    End With

Then on lines 283, 1133, 1421, 1996, 2144, 2230, and 2274 I have lines that tell it to Merge Cells. Here are the code snippets that do that...

        ActiveSheet.Range("A1:B1").Merge

            With Sheets(FileName & strNT).Range("A" & x & ":H" & x)
                .MergeCells = True
                .WrapText = True
            End With

            Sheets(FileName & strWS).Range("A" & x & ":C" & x).MergeCells = True

            With Sheets(FileName & strCP).Range("A" & x & ":H" & x)
                .MergeCells = True
                .WrapText = True
            End With

            With Sheets(FileName & strVPN).Range("A" & x & ":H" & x)
                .MergeCells = True
                .WrapText = True
            End With

            With Sheets(FileName & " Maps").Range("A" & x & ":H" & x)
                .MergeCells = True
                .WrapText = True
            End With

            With Sheets(FileName & strAL).Range("A" & x & ":H" & x)
                .MergeCells = True
                .WrapText = True
            End With

I am getting the warning message "Merging cells only keeps the upper-left value and discards other values." three times at the end of my code.

Here is what I have attempted...

1) Placing Application.DisplayAlerts = False just before every place that merges cells.
2) Putting breaks at every line that merge cells so that I can see where it is throwing that warning. That DID NOT work. The code stopped at every break, and then when I would get past that line and press play, it still threw the warning three times at the end without breaking first.

I do not have a variable at the beginning of the code declaring something else for the Excel Application.

Any thoughts?

Thank you.

 

[6StringJazzer]

In the following two examples there is data in all four cells.

This code gives a warning

    Range("A1:B2").Merge

This code does not give a warning

Application.DisplayAlerts = False
    Range("A1:B2").Merge
Application.DisplayAlerts = True

I know you have a lot of code but it will difficult to diagnose without seeing all of your code. There could be something not obvious causing an issue.

Second, merging cells is a poor practice and should be avoided. It can cause problems doing certain things in the user interface and can wreak havoc in VBA. Also that warning suggests you have data in the cells you are merging and you are going to lose that data. Doesn't sound desirable.

BTW if you have a single sub with over 2000 lines of code I would say a redesign is required.

 

[Dad_x6]

Not one sub. Thirteen of them. I'll have to look into the merges to see what data is being lost. I am PRETTY sure that it is no worry, but I will check.

My code is longer than 10,000 characters which Mr. Excel does not allow. So I will attempt to post half of it, and then the other half.

Option Explicit

Dim FileName As Variant
Dim rng As Range
Dim v, x, y, yOrig, P, d, a, CPR, tabCol, AL, xMap, used As Long
Dim strUser, strOrigUser, strBanner, strCompanyName, strUserTemp, strVPN, strVPN2, strCP, strAL, strRP, strWS, strNT, strLog, strVLAN, strTO As String
Dim i, j, z, ai, aCnt, b As Integer
Dim blMap, blAL, blVPN, blCP, blRP, blNAT, blVLAN, aBool, blTelnet As Boolean 'blMap = Maps; blAL = Access Lists; blCP = Control Plane; blRP = Routing Protocols
Dim sht As Worksheet
Dim FileCnt As Integer
Dim varPass(1 To 23), varFail(1 To 22), varFailDate(1 To 22), varSortOf(1) As Variant
Dim wbMain As Workbook

Public Sub Configs()
    Set rng = Nothing

    v = 27
    x = 8
    P = 4
    d = 4
    CPR = 2 'Control Plane sheet row
    tabCol = 5000 'Tab Color
    AL = 2 'Access Lists sheet row counter
    xMap = 2 'Row counter for Maps worksheet
    j = 1
    z = 1
    ai = 1
    aCnt = 0
    
Dim strDate As String
    strOrigUser = ""
    FileCnt = 0
Dim intSht As Integer
Dim txtWkBk As Workbook
Dim Folder, lastSht As String
    varPass(1) = "c15"
    varPass(2) = "ios*6.4.2"
    varPass(3) = "3402"
    varPass(4) = "5506"
    varPass(5) = "901"
    varPass(6) = "9200"
    varPass(7) = "16.9"
    varPass(8) = "16.12"
    varPass(9) = "3850"
    varPass(10) = "16.6"
    varPass(11) = "9.8"
    varPass(12) = "9700"
    varPass(13) = "3400"
    varPass(14) = "Stackable ICX7750"
    varPass(15) = "6.7.2"
    varPass(16) = "6.0.2"
    varPass(17) = "16.09"
    varPass(18) = "ICX6610" 'EOL 11/2/2023
    varPass(19) = "7.2"
    varPass(20) = "7.0"
    varPass(21) = "6.4"
    varPass(22) = "6.2" 'EOL 9/28/2023
    varPass(23) = "3650"

    varFail(1) = "7206"
    varFail(2) = "12.2"
    varFail(3) = "8.3.2.0"
    varFail(4) = "8.4.2.7"
    varFail(5) = "12.4"
    varFail(6) = "15.0"
    varFail(7) = "15.2"
    varFail(8) = "3750"
    varFail(9) = "3550"
    varFail(10) = "2960"
    varFail(11) = "Version 9"
    varFail(12) = "Version 08.0.1"
    varFail(13) = "S50N"
    varFail(14) = "Force10"
    varFail(15) = "1.3.0.62"
    varFail(16) = "C3750 Boot Loader"
    varFail(17) = "6.0"
    varFail(18) = "16.3"
    varFail(19) = "1.0"
    varFail(20) = "1.1"
    varFail(21) = "1.2"
    varFail(22) = "1.3"
    
    varFailDate(1) = "09/30/2017"
    varFailDate(2) = "03/02/2010"
    varFailDate(3) = "11/15/2019"
    varFailDate(4) = "03/31/2020"
    varFailDate(5) = "12/26/2012"
    varFailDate(6) = "05/31/2021"
    varFailDate(7) = "04/30/2022"
    varFailDate(8) = "01/31/2018"
    varFailDate(9) = "05/02/2011"
    varFailDate(10) = "10/31/2019"
    varFailDate(11) = "12/31/2018"
    varFailDate(12) = "04/30/2018"
    varFailDate(13) = "01/01/2013"
    varFailDate(14) = "01/01/2013"
    varFailDate(15) = "05/31/2022"
    varFailDate(16) = "01/31/2018"
    varFailDate(17) = "09/29/2022"
    varFailDate(18) = "08/01/2020"
    varFailDate(19) = "07/31/2022"
    varFailDate(20) = "07/31/2022"
    varFailDate(21) = "07/31/2022"
    varFailDate(22) = "07/31/2022"
    
Dim varFile As Variant
Dim i As Integer
    i = 0
Dim wkbk As Workbook

    

    MsgBox ("Open the folder to your configs.")
    Folder = GetFolder & "\"
    If Folder = "\" Then Exit Sub
    If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
    varFile = Dir(Folder)
    While (varFile <> "")
        i = i + 1
        varFile = Dir
    Wend
    FileCnt = i
'    FileCnt = CountFiles(CStr(Folder))
    
Dim lngRowHeight As Long
    
    strCompanyName = InputBox("What is the company's name?")
    If strCompanyName = "" Then Exit Sub
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .AskToUpdateLinks = False
    End With

    strDate = CStr(MonthName(Month(Date), True) & "." & Day(Date) & "." & Year(Date))
    
    If OpenWkBks(strCompanyName & " Config Analysis_" & strDate & ".xls") = True Then
        Workbooks(strCompanyName & " Config Analysis_" & strDate & ".xls").Close False
    End If
    
    If Dir(Folder & strCompanyName & " Config Analysis_" & strDate & ".xls") <> "" Then
        Kill (Folder & strCompanyName & " Config Analysis_" & strDate & ".xls")
    End If
    
    On Error Resume Next
    Workbooks(strCompanyName & " Config Analysis_" & strDate & ".xls").Close False
    On Error GoTo 0
    
    ActiveWorkbook.SaveAs Folder & strCompanyName & " Config Analysis_" & strDate & ".xls", FileFormat:=56
    Set wbMain = ActiveWorkbook
    
    FileName = Dir(Folder)

    Do While Len(FileName) > 0
        If InStr(1, FileName, "log") = 0 And InStr(1, FileName, "txt") = 0 And InStr(1, FileName, "conf") = 0 Then GoTo NextFile
        If FileName = ActiveWorkbook.Name Then GoTo NextFile
        Application.StatusBar = "There are " & FileCnt & " files left to go."
        Set txtWkBk = Workbooks.Open(Folder & FileName)
        If InStr(1, LCase(FileName), "forti") Or InStr(1, LCase(FileName), "conf") > 0 Then
            Call Forti
            GoTo NextFile
        End If
        On Error Resume Next
        If Right(FileName, 3) <> "txt" And Right(FileName, 3) <> "log" Then GoTo NextFile
        FileName = Left(FileName, InStr(1, FileName, ".") - 1)
        If Len(FileName & " VPN-Encryption") <= 25 Then
            strVPN = " VPN-Encryption"
        ElseIf Len(FileName & " VPN-Encrypt") <= 25 Then
            strVPN = " VPN-Encrypt"
        Else
            strVPN = " VPN"
        End If
        If Len(FileName & " Control Plane") <= 25 Then
            strCP = " Control Plane"
        ElseIf Len(FileName & " Cont Plane") <= 25 Then
            strCP = " Cont Plane"
        Else
            strCP = " CP"
        End If
        If Len(FileName & " Access Lists") <= 25 Then
            strAL = " Access Lists"
        ElseIf Len(FileName & " Acc Lists") <= 25 Then
            strAL = " Acc Lists"
        Else
            strAL = " AL"
        End If
        If Len(FileName & " Worksheet") <= 25 Then
            strWS = " Worksheet"
        ElseIf Len(FileName & " Worksht") <= 25 Then
            strWS = " Worksht"
        Else
            strWS = " WS"
        End If
        
        Application.ScreenUpdating = False
        
        If Len(FileName & " Nat Tables") <= 25 Then
            strNT = " Nat Tables"
        ElseIf Len(FileName & " Nat Tab") <= 25 Then
            strNT = " Nat Tab"
        Else
            strNT = " NT"
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="hostname")
        If Not rng Is Nothing Then
            y = rng.row
            If Left(Sheets(FileName).Cells(y, 1), 8) = "hostname" Then FileName = Mid(Sheets(FileName).Cells(y, 1), 10, 20)
        End If
        On Error GoTo 0
        ActiveSheet.Cells.Select
        Selection.Copy
        ThisWorkbook.Activate
        If lastSht <> "" Then
            Sheets.Add , Sheets(lastSht)
        Else
            Sheets.Add , Sheets("STARTER TAB")
        End If
        If Len(FileName) > 22 Then
            FileName = Left(CStr(FileName), 20)
        End If
        If FileName = "" Then
            ActiveSheet.Delete
            GoTo NextFile
        End If
        ActiveSheet.Name = CStr(FileName)
        lastSht = CStr(FileName)
        ActiveSheet.Cells(1, 1).Select
        ActiveSheet.Paste
        txtWkBk.Application.CutCopyMode = False
        txtWkBk.Close
        Sheets.Add , ActiveSheet
        ActiveSheet.Tab.Color = tabCol
        ActiveSheet.Name = FileName & " Analysis"
        lastSht = ActiveSheet.Name
        With ActiveWindow
            .SplitColumn = 0
            .SplitRow = 1
        End With
        ActiveWindow.FreezePanes = True
        Cells.WrapText = True
        Cells.HorizontalAlignment = xlLeft
        With Columns(1)
            .ColumnWidth = 21
            .HorizontalAlignment = xlLeft
        End With
        
        Application.ScreenUpdating = False
        
        Range("B:C").ColumnWidth = 90
        Range("D:H").ColumnWidth = 31
        Range("C:D").ColumnWidth = 100
        Sheets("Starter Tab").Range("A1:D127").Copy
        ActiveSheet.Cells(1, 1).Select
        ActiveSheet.Paste
        ActiveSheet.Range("A2:D124").Font.Bold = False
        ActiveSheet.Range("A26:A27").Delete
        Sheets.Add , ActiveSheet
        ActiveSheet.Tab.Color = tabCol
        ActiveSheet.Name = FileName & strWS
        ActiveSheet.Range("A1:C1").Select
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ThemeColor = 5
            .TintAndShade = -0.249946592608417
            .Weight = xlThin
        End With
        lastSht = ActiveSheet.Name
        Sheets(FileName & " Analysis").Activate
        
        Application.ScreenUpdating = False
        
        Call Analysis
        Application.ScreenUpdating = False
        
'WORKSHEET COMPILATION
        Sheets(FileName & strWS).Activate
        ActiveSheet.Range("A:B").ColumnWidth = 23
        ActiveSheet.Columns(3).ColumnWidth = 40
        Application.DisplayAlerts = False
        ActiveSheet.Range("A1:B1").Merge
'        With ActiveSheet.Cells(1, 1)
'            .Font.Size = 16
'            .Value = FileName & "Device Analysis"
'            .Font.Color = 6299648
'            .Font.Bold = True
'        End With
'Set Header for Worksheet
        ActiveWindow.View = xlPageLayoutView
        With Selection.Font
            .Color = -10477568
            .TintAndShade = 0
        End With
        Selection.Font.Bold = True
        Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .LeftHeader = "&""-,Bold""&16&K002060" & FileName & " Device Analysis"
            .CenterHeader = ""
            .RightHeader = "Page &P of &N"
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.7)
            .RightMargin = Application.InchesToPoints(0.7)
            .TopMargin = Application.InchesToPoints(0.75)
            .BottomMargin = Application.InchesToPoints(0.75)
            .HeaderMargin = Application.InchesToPoints(0.3)
            .FooterMargin = Application.InchesToPoints(0.3)
            .Zoom = 100
            .PrintErrors = xlPrintErrorsDisplayed
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
            .ScaleWithDocHeaderFooter = True
            .AlignMarginsHeaderFooter = True
            .EvenPage.LeftHeader.Text = ""
            .EvenPage.CenterHeader.Text = ""
            .EvenPage.RightHeader.Text = ""
            .EvenPage.LeftFooter.Text = ""
            .EvenPage.CenterFooter.Text = ""
            .EvenPage.RightFooter.Text = ""
            .FirstPage.LeftHeader.Text = ""
            .FirstPage.CenterHeader.Text = ""
            .FirstPage.RightHeader.Text = ""
            .FirstPage.LeftFooter.Text = ""
            .FirstPage.CenterFooter.Text = ""
            .FirstPage.RightFooter.Text = ""
        End With
        Application.PrintCommunication = True
        With ActiveSheet.Cells(500, 1)
            .Value = FileName
            .Font.Color = -10477568
            .Font.Bold = True
            .Font.Size = 16
        End With
        
        
        With ActiveSheet.Range("A3:C3")
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
        End With
        With ActiveSheet.Range("A3:B24")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        ActiveSheet.Range("B4:B24").Font.Bold = True
        With ActiveSheet.Range("C3:C24")
            .VerticalAlignment = xlCenter
            .WrapText = True
            .HorizontalAlignment = xlLeft
        End With
'Labels
        Sheets(FileName & strWS).Cells(4, 1) = "Control"
        Sheets(FileName & strWS).Cells(4, 2) = "Pass / Fail"
        Sheets(FileName & strWS).Cells(4, 3) = "Config Data"
        Sheets(FileName & strWS).Range("A4:C4").Font.Bold = True
        Sheets(FileName & strWS).Cells(5, 1) = "Model"
        Sheets(FileName & strWS).Cells(6, 1) = "Config Version"
        Sheets(FileName & strWS).Cells(7, 1) = "Clock Setting"
        Sheets(FileName & strWS).Cells(8, 1) = "NTP Server(s)"
        Sheets(FileName & strWS).Cells(9, 1) = "Users/Groups"
        Sheets(FileName & strWS).Cells(10, 1) = "Banner"
        Sheets(FileName & strWS).Cells(11, 1) = "Rad. AAA Server / Tacacs"
        Sheets(FileName & strWS).Cells(12, 1) = "Admin Timeouts"
        Sheets(FileName & strWS).Cells(13, 1) = "Control Plane"
        Sheets(FileName & strWS).Cells(14, 1) = "Access Lists"
        Sheets(FileName & strWS).Cells(15, 1) = "SSH Server(s)"
        Sheets(FileName & strWS).Cells(16, 1) = "Logging"
        Sheets(FileName & strWS).Cells(17, 1) = "SNMP Server(s)"
        Sheets(FileName & strWS).Cells(18, 1) = "Routing Protocol(s)"
        Sheets(FileName & strWS).Cells(19, 1) = "VPN-Encryption"
        Sheets(FileName & strWS).Cells(20, 1) = "Map(s)"
        Sheets(FileName & strWS).Cells(21, 1) = "Login Interface(s)"
        Sheets(FileName & strWS).Cells(22, 1) = "Unencrypted Services"
        Sheets(FileName & strWS).Cells(23, 1) = "NAT"
        Sheets(FileName & strWS).Cells(24, 1) = "VLANs"
'Config Data

'Model Worksheet
        If Sheets(FileName & " Analysis").Cells(6, 2) <> "" Then
            Sheets(FileName & strWS).Cells(5, 3) = Sheets(FileName & " Analysis").Cells(6, 2).Value
        ElseIf Sheets(FileName & " Analysis").Cells(2, 2) <> "" Then
            Sheets(FileName & strWS).Cells(5, 3) = Sheets(FileName & " Analysis").Cells(2, 2).Value
        Else
            Sheets(FileName & strWS).Cells(5, 2) = "Unknown"
            Sheets(FileName & strWS).Cells(5, 3) = "Unable to determine by config"
        End If
        For b = 1 To UBound(varPass)
            If InStr(1, Sheets(FileName & strWS).Cells(5, 3), varPass(b)) > 0 Then
                With Sheets(FileName & strWS).Cells(5, 2)
                    .Font.Bold = True
                    .Interior.Color = 5287936
                    .Font.Color = 16777215
                    .Value = "Pass"
                End With
            End If
        Next b
        If Sheets(FileName & strWS).Cells(5, 2) <> "Pass" Then
            For b = 1 To UBound(varFail)
                If InStr(1, Sheets(FileName & strWS).Cells(5, 3), varFail(b)) > 0 Then
                    With Sheets(FileName & strWS).Cells(5, 2)
                        .Font.Color = 16777215
                        .Interior.Color = 192
                        .Value = "Fail"
                    End With
                    If varFailDate(b) <> "" Then
                        Sheets(FileName & strWS).Cells(5, 3) = Sheets(FileName & strWS).Cells(5, 3) & Chr(10) & "Last Day of Support: " & varFailDate(b)
                    End If
                    Call ColorWord(Sheets(FileName & strWS).Cells(5, 3), FileName & strWS, 5, Sheets(FileName & " Analysis").Cells(6, 2))
                End If
            Next b
            If Sheets(FileName & strWS).Cells(5, 2) = "" And InStr(1, Sheets(FileName & strWS).Cells(5, 3), "9904") > 0 Then
                With Sheets(FileName & strWS).Cells(5, 2)
                    .Font.Color = 0
                    .Interior.Color = 65535
                    .Value = "Check"
                End With
            End If
            If InStr(1, Sheets(FileName & " Analysis").Cells(5, 2), "9904") > 0 Then Sheets(FileName & strWS).Cells(5, 3) = "9904 -- Check - 8/31/2022"
        End If
        If Len(Sheets(FileName & strWS).Cells(5, 3)) = 1 Then
            Sheets(FileName & strWS).Cells(5, 2) = "Unknown"
            Sheets(FileName & strWS).Cells(5, 3) = "Unable to determine by config"
        End If
        If Sheets(FileName & strWS).Cells(5, 2) = "" Then
            With Sheets(FileName & strWS).Cells(5, 2)
                .Value = "Unknown"
                .Interior.Color = 65535
                .Font.Bold = True
            End With
        End If
            

'Config Version Worksheet
        If Sheets(FileName & " Analysis").Cells(5, 2) <> "" Then
            Sheets(FileName & strWS).Cells(6, 3) = Sheets(FileName & " Analysis").Cells(5, 2).Value
        Else
            Set rng = Sheets(FileName).Range("A:A").find(What:="Operating System")
            If Not rng Is Nothing Then
                y = rng.row
                Sheets(FileName & strWS).Cells(6, 3) = Sheets(FileName).Cells(y, 1)
                For b = 1 To UBound(varPass)
                    If InStr(1, Sheets(FileName & strWS).Cells(5, 3), varPass(b)) > 0 Then
                        With Sheets(FileName & strWS).Cells(5, 2)
                            .Font.Bold = True
                            .Interior.Color = 5287936
                            .Font.Color = 16777215
                            .Value = "Pass"
                        End With
                    End If
                Next b
                For b = 1 To UBound(varFail)
                    If InStr(1, Sheets(FileName & strWS).Cells(6, 3), varFail(b)) > 0 Then
                        With Sheets(FileName & strWS).Cells(6, 2)
                            .Font.Bold = True
                            .Interior.Color = 192
                            .Font.Color = 16777215
                            .Value = "Fail"
                        End With
                    End If
                Next b
            End If
        End If
        If Sheets(FileName & strWS).Cells(6, 3) = "" Then
            Sheets(FileName & strWS).Cells(6, 3) = "Unable to determine by config"
            Sheets(FileName & strWS).Cells(6, 2) = "Unknown"
        End If
        For b = 1 To UBound(varPass)
            If InStr(1, Sheets(FileName & strWS).Cells(6, 3), varPass(b)) > 0 Then
                With Sheets(FileName & strWS).Cells(6, 2)
                    .Font.Bold = True
                    .Interior.Color = 5287936
                    .Font.Color = 16777215
                    .Value = "Pass"
                End With
                Exit For
            End If
        Next b
        If Sheets(FileName & strWS).Cells(6, 2) <> "Pass" Then
            For b = 1 To UBound(varFail)
                If InStr(1, Sheets(FileName & strWS).Cells(6, 3), varFail(b)) > 0 Then
                    With Sheets(FileName & strWS).Cells(6, 2)
                        .Font.Color = 16777215
                        .Interior.Color = 192
                        .Value = "Fail"
                    End With
                    If varFailDate(b) <> "" Then
                        Sheets(FileName & strWS).Cells(6, 3) = Sheets(FileName & strWS).Cells(6, 3) & Chr(10) & "Last Day of Support: " & varFailDate(b)
                    End If
                    Call ColorWord(Sheets(FileName & strWS).Cells(6, 3), FileName & strWS, 6, Sheets(FileName & " Analysis").Cells(5, 2))
                    Exit For
                End If
            Next b
        End If
        If Sheets(FileName & strWS).Cells(6, 2) = "" Then
            With Sheets(FileName & strWS).Cells(6, 2)
                .Value = "Unknown"
                .Interior.Color = 65535
                .Font.Bold = True
            End With
        End If
        
'Clock Setting Worksheet
        ActiveSheet.Cells(7, 3) = Sheets(FileName & " Analysis").Cells(11, 2).Value
        If Sheets(FileName & " Analysis").Cells(11, 2).Font.Color = 255 Then
            With ActiveSheet.Cells(7, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
        End If
        If ActiveSheet.Cells(7, 3) <> "" And ActiveSheet.Cells(7, 3) <> "A timezone is not set on this device." Then
            With ActiveSheet.Cells(7, 2)
                .Font.Bold = True
                .Interior.Color = 5287936
                .Font.Color = 16777215
                .Value = "Pass"
            End With
        End If
        If Sheets(FileName & strWS).Cells(7, 3) = "A timezone is not set on this device." Then
            Call ColorWord(Sheets(FileName & strWS).Cells(7, 3), FileName & strWS, 7, "A timezone is not set on this device.")
        End If
'NTP Server Worksheet
        ActiveSheet.Cells(8, 3) = Sheets(FileName & " Analysis").Cells(9, 2).Value
        If Sheets(FileName & " Analysis").Cells(9, 2).Font.Color = 255 Or Sheets(FileName & " Analysis").Cells(9, 2) = "There are no NTP Servers specified for this device." Then
            With ActiveSheet.Cells(8, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
            Sheets(FileName & strWS).Cells(8, 3).Font.Color = 255
        ElseIf Sheets(FileName & " Analysis").Cells(9, 2) <> "There are no NTP Servers specified for this device." Then
            With ActiveSheet.Cells(8, 2)
                .Value = "Pass"
                .Interior.Color = 5287936
                .Font.Color = 16777215
            End With
        Else
            With ActiveSheet.Cells(8, 2)
                .Value = "N/A"
                .Interior.Color = 14277081
            End With
        End If
'Users/Groups Worksheet
        ActiveSheet.Cells(9, 3) = Sheets(FileName & " Analysis").Cells(10, 2).Value
        If Sheets(FileName & " Analysis").Cells(10, 2).Font.Color = 255 Then
            With ActiveSheet.Cells(9, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
        Else
            With ActiveSheet.Cells(9, 2)
                .Font.Color = 16777215
                .Interior.Color = 5287936
                .Value = "Pass"
            End With
        End If
        Call ColorWord(ActiveSheet.Cells(9, 3), ActiveSheet.Name, 9, "password 0")
        Call ColorWord(ActiveSheet.Cells(9, 3), ActiveSheet.Name, 9, "password 5")
        Call ColorWord(ActiveSheet.Cells(9, 3), ActiveSheet.Name, 9, "password 7")
'Banner Worksheet
        ActiveSheet.Cells(10, 3) = Sheets(FileName & " Analysis").Cells(12, 2).Value
        If Sheets(FileName & " Analysis").Cells(12, 2) = "" Or Sheets(FileName & " Analysis").Cells(12, 2) = "There is no banner set on this device." Then
            With ActiveSheet.Cells(10, 2)
                .Font.Bold = True
                .Interior.Color = 192
                .Font.Color = 16777215
                .Value = "Fail"
                With ActiveSheet.Cells(10, 3)
                    .Value = "There is no banner set on this device."
                End With
            End With
            Call ColorWord(ActiveSheet.Cells(10, 3), ActiveSheet.Name, 10, "There is no banner set on this device.")
        End If
        If InStr(1, ActiveSheet.Cells(10, 3), "***") > 0 Then
            With ActiveSheet.Cells(10, 2)
                .Font.Bold = True
                .Interior.Color = 5287936
                .Font.Color = 16777215
                .Value = "Pass"
            End With
        End If
'AAA Server/Tacacs Worksheet
        ActiveSheet.Cells(11, 3) = Sheets(FileName & " Analysis").Cells(13, 2).Value
        If Sheets(FileName & " Analysis").Cells(13, 2).Font.Color = 255 Then
            With ActiveSheet.Cells(11, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
        ElseIf Sheets(FileName & " Analysis").Cells(13, 2) <> "There is no AAA server or Tacacs set on this device." Then
            With ActiveSheet.Cells(11, 2)
                .Value = "Pass"
                .Interior.Color = 5287936
                .Font.Color = 16777215
            End With
        Else
            With ActiveSheet.Cells(11, 2)
                .Value = "N/A"
                .Interior.Color = 14277081
            End With
        End If
'Admin Timeouts Worksheet
        If Sheets(FileName & " Analysis").Cells(23, 2) <> "" Then 'There is a Telnet Timeout
            Sheets(FileName & strWS).Cells(12, 3) = Sheets(FileName & " Analysis").Cells(23, 2)
            With Sheets(FileName & strWS).Cells(12, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Font.Bold = True
            End With
            Call ColorWord(Sheets(FileName & strWS).Cells(12, 3), Sheets(FileName & strWS).Name, 12, Sheets(FileName & " Analysis").Cells(23, 2))
        End If
        If Sheets(FileName & " Analysis").Cells(16, 2) <> "" Then 'SSH
            If Sheets(FileName & strWS).Cells(12, 3) <> "" Then
                Sheets(FileName & strWS).Cells(12, 3) = Sheets(FileName & strWS).Cells(12, 3) & Chr(10) & Sheets(FileName & " Analysis").Cells(16, 2)
            Else
                Sheets(FileName & strWS).Cells(12, 3) = Sheets(FileName & " Analysis").Cells(16, 2)
            End If
            If Sheets(FileName & " Analysis").Cells(16, 2) < 1200 Then
                Call ColorWord(Sheets(FileName & strWS).Cells(12, 2), "FileName" & " Worksheet", 12, Sheets(FileName & " Analysis").Cells(16, 2))
                With Sheets(FileName & strWS).Cells(12, 2)
                    .Font.Color = 16777215
                    .Interior.Color = 192
                    .Value = "Fail"
                End With
            Else
                With Sheets(FileName & strWS).Cells(12, 2)
                    .Value = "Pass"
                    .Interior.Color = 5287936
                    .Font.Color = 16777215
                End With
            End If
        Else
            With Sheets(FileName & strWS).Cells(12, 2)
                .Value = "N/A"
                .Font.Bold = True
                .Interior.Color = 14277081
            End With
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="console timeout")
        If Not rng Is Nothing Then
            y = rng.row
            If CInt(Mid(Sheets(FileName).Cells(y, 1), 16, 2)) < 1200 And Sheets(FileName & " Analysis").Cells(16, 2) <> "" Then
                With Sheets(FileName & strWS).Cells(12, 2)
                    .Font.Color = 16777215
                    .Interior.Color = 192
                    .Value = "Fail"
                End With
                If Sheets(FileName & strWS).Cells(12, 3) <> "" Then
                    Sheets(FileName & strWS).Cells(12, 3) = Sheets(FileName & strWS).Cells(12, 3) & Chr(10) & Sheets(FileName).Cells(y, 1)
                    Call ColorWord(Sheets(FileName & strWS).Cells(12, 3), Sheets(FileName & strWS).Name, 12, Sheets(FileName).Cells(y, 1))
'                    Call ColorWord(Sheets(FileName & strWS).Cells(12,3),Sheets(FileName & strWS),12,
                Else
                    Sheets(FileName & strWS).Cells(12, 3) = Sheets(FileName).Cells(y, 1)
                    Call ColorWord(Sheets(FileName & strWS).Cells(12, 3), Sheets(FileName & strWS).Name, 12, Sheets(FileName).Cells(y, 1))
                End If
            Else
                With Sheets(FileName & strWS).Cells(12, 2)
                    .Value = "Pass"
                    .Interior.Color = 5287936
                    .Font.Color = 16777215
                End With
            End If
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="exec-timeout")
        If Not rng Is Nothing Then
            y = rng.row
            If CInt(Mid(Sheets(FileName).Cells(y, 1), 16, 2)) < 20 Then
                With Sheets(FileName & strWS).Cells(12, 2)
                    .Font.Color = 16777215
                    .Interior.Color = 192
                    .Value = "Fail"
                End With
                If Sheets(FileName & strWS).Cells(12, 3) <> "" Then
                    Sheets(FileName & strWS).Cells(12, 3) = Sheets(FileName & strWS).Cells(12, 3) & Chr(10) & Sheets(FileName).Cells(y, 1)
                    Call ColorWord(Sheets(FileName & strWS).Cells(12, 3), Sheets(FileName & strWS).Name, 12, Sheets(FileName).Cells(y, 1))
                Else
                    Sheets(FileName & strWS).Cells(12, 3) = Sheets(FileName).Cells(y, 1)
                    Call ColorWord(Sheets(FileName & strWS).Cells(12, 3), Sheets(FileName & strWS).Name, 12, Sheets(FileName).Cells(y, 1))
                End If
            Else
                With Sheets(FileName & strWS).Cells(12, 2)
                    .Value = "Pass"
                    .Interior.Color = 5287936
                    .Font.Color = 16777215
                End With
            End If
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="absolute-timeout")
        If Not rng Is Nothing Then
            y = rng.row
            If CInt(Mid(Sheets(FileName).Cells(y, 1), 18, 2)) < 20 Then
                With Sheets(FileName & strWS).Cells(12, 2)
                    .Font.Color = 16777215
                    .Interior.Color = 192
                    .Value = "Fail"
                End With
                If Sheets(FileName & strWS).Cells(12, 3) <> "" Then
                    Sheets(FileName & strWS).Cells(12, 3) = Sheets(FileName & strWS).Cells(12, 3) & Chr(10) & Sheets(FileName).Cells(y, 1)
                    Call ColorWord(Sheets(FileName & strWS).Cells(12, 3), Sheets(FileName & strWS).Name, 12, Sheets(FileName).Cells(y, 1))
                Else
                    Sheets(FileName & strWS).Cells(12, 3) = Sheets(FileName).Cells(y, 1)
                    Call ColorWord(Sheets(FileName & strWS).Cells(12, 3), Sheets(FileName & strWS).Name, 12, Sheets(FileName).Cells(y, 1))
                End If
            Else
                With Sheets(FileName & strWS).Cells(12, 2)
                    .Value = "Pass"
                    .Interior.Color = 5287936
                    .Font.Color = 16777215
                End With
            End If
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="session-timeout")
        If Not rng Is Nothing Then
            y = rng.row
            If CInt(Mid(Sheets(FileName).Cells(y, 1), 17, 2)) < 20 Then
                With Sheets(FileName & strWS).Cells(12, 2)
                    .Font.Color = 16777215
                    .Interior.Color = 192
                    .Value = "Fail"
                End With
                If Sheets(FileName & strWS).Cells(12, 3) <> "" Then
                    Sheets(FileName & strWS).Cells(12, 3) = Sheets(FileName & strWS).Cells(12, 3) & Chr(10) & Sheets(FileName).Cells(y, 1)
                    Call ColorWord(Sheets(FileName & strWS).Cells(12, 3), Sheets(FileName & strWS).Name, 12, Sheets(FileName).Cells(y, 1))
                Else
                    Sheets(FileName & strWS).Cells(12, 3) = Sheets(FileName).Cells(y, 1)
                    Call ColorWord(Sheets(FileName & strWS).Cells(12, 3), Sheets(FileName & strWS).Name, 12, Sheets(FileName).Cells(y, 1))
                End If
            Else
                With Sheets(FileName & strWS).Cells(12, 2)
                    .Value = "Pass"
                    .Interior.Color = 5287936
                    .Font.Color = 16777215
                End With
            End If
        End If
'        Set rng = Sheets(FileName).Range("A:A").find(What:="timeout")
'        If Not rng Is Nothing Then
'            y = rng.row
'            strTO = Sheets(FileName).Cells(y, 1)
'            y = y + 1
'            Do Until rng Is Nothing
'                Set rng = Sheets(FileName).Range("A" & y & ":A" & Sheets(FileName).UsedRange.Rows.Count).find(What:="timeout")
'                If Not rng Is Nothing Then
'                    y = rng.row
'                End If
'            Loop
'            With ActiveSheet.Cells(13, 2)
'                .Font.Color = 16777215
'                .Interior.Color = 192
'                .Value = "Fail"
'            End With
'        ElseIf Sheets(FileName & strCP).Cells(2, 1) <> "There were no Control Planes listed with this host." Then
'            With ActiveSheet.Cells(13, 2)
'                .Value = "Pass"
'                .Interior.Color = 5287936
'                .Font.Color = 16777215
'            End With
'        Else
'            With ActiveSheet.Cells(13, 2)
'                .Value = "N/A"
'                .Interior.Color = 14277081
'            End With
'        End If
        If blTelnet = True Then
            With ActiveSheet.Cells(13, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
            Sheets(FileName & strWS).Cells(13, 3) = "Telnet in use"
            Call ColorWord(Sheets(FileName & strWS).Cells(13, 3), FileName & strWS, 13, "Telnet in use")
        End If
        If Sheets(FileName & strWS).Cells(13, 2) = "" Then
            With ActiveSheet.Cells(13, 2)
                .Value = "N/A"
                .Interior.Color = 14277081
            End With
        End If
'Access Lists Worksheet
        ActiveSheet.Cells(14, 3) = "See Appendix B"
        Dim intAnyAny As Integer
            intAnyAny = 0
        Set rng = Sheets(FileName & strAL).Range("A:A").find(What:="permit*any any")
        If Not rng Is Nothing Then
            y = rng.row
            Do Until rng Is Nothing Or intAnyAny > 5
                Set rng = Sheets(FileName).Range("A" & y + 1 & ":A" & Sheets(FileName).UsedRange.Rows.Count).find(What:="permit*any any")
                If Not rng Is Nothing Then
                    intAnyAny = intAnyAny + 1
                End If
            Loop
                If intAnyAny > 3 Then
                    Sheets(FileName & strWS).Cells(14, 3) = Sheets(FileName & strWS).Cells(14, 3) & Chr(10) & "Numerous instances of Permit any any"
                    Call ColorWord(Sheets(FileName & strWS).Cells(14, 3), FileName & strWS, 14, "Numerous instances of Permit any any")
                ElseIf intAnyAny > 0 Then
                    Sheets(FileName & strWS).Cells(14, 3) = Sheets(FileName & strWS).Cells(14, 3) & Chr(10) & "Permit any any found " & " times"
                    Call ColorWord(Sheets(FileName & strWS).Cells(14, 3), FileName & strWS, 14, "Permit any any found ")
                    Call ColorWord(Sheets(FileName & strWS).Cells(14, 3), FileName & strWS, 14, " times")
                End If
            With ActiveSheet.Cells(14, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
            GoTo SSH
        End If
        Set rng = Sheets(FileName & strAL).Range("A:A").find(What:="permit*any any")
        If Not rng Is Nothing Then
            y = rng.row
            With ActiveSheet.Cells(14, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
            ActiveSheet.Cells(14, 3) = ActiveSheet.Cells(14, 3) & Chr(10) & Sheets(FileName & strAL).Cells(y, 1)
            Call ColorWord(ActiveSheet.Cells(14, 3), ActiveSheet.Name, 14, "any any")
        End If
        If Sheets(FileName & " Analysis").Cells(25, 2).Font.Color = 255 Then
            With ActiveSheet.Cells(14, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
        ElseIf Sheets(FileName & strAL).Cells(2, 1) <> "There were no Access Lists listed with this device." Then
            If Sheets(FileName & strWS).Cells(14, 2) = "" Then
                With ActiveSheet.Cells(14, 2)
                    .Font.Bold = True
                    .Interior.Color = 5287936
                    .Font.Color = 16777215
                    .Value = "Pass"
                End With
            End If
        Else
            If Sheets(FileName & strWS).Cells(14, 2) = "" Then
                With ActiveSheet.Cells(14, 2)
                    .Font.Bold = True
                    .Font.Color = 0
                    .Value = "N/A"
                    .Interior.Color = 14277081
                End With
            End If
        End If
'SSH Server Worksheet
SSH:
        ActiveSheet.Cells(15, 3) = Sheets(FileName & " Analysis").Cells(15, 2).Value
        If Sheets(FileName & " Analysis").Cells(15, 2).Font.Color = 255 Then
            With ActiveSheet.Cells(15, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
        End If
        If ActiveSheet.Cells(15, 3) = True Then
            With ActiveSheet.Cells(15, 2)
                .Font.Bold = True
                .Interior.Color = 5287936
                .Font.Color = 16777215
                .Value = "Pass"
            End With
        Else
            With ActiveSheet.Cells(15, 2)
                .Font.Bold = True
                .Font.Color = 0
                .Value = "N/A"
                .Interior.Color = 14277081
            End With
        End If
'Logging Worksheet
        Sheets(FileName & strWS).Cells(16, 3) = Sheets(FileName & " Analysis").Cells(17, 2).Value
        If Sheets(FileName & " Analysis").Cells(17, 2).Font.Color = 255 Then
            With Sheets(FileName & strWS).Cells(16, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
        End If
        If RegExx(Sheets(FileName & strWS).Cells(16, 3)) = True Then
            With Sheets(FileName & strWS).Cells(16, 2)
                .Value = "Pass"
                .Interior.Color = 5287936
                .Font.Color = 16777215
            End With
        Else
            With Sheets(FileName & strWS).Cells(16, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
            If Sheets(FileName & strWS).Cells(16, 3) <> "There are no logging servers set on this device." Then
                Sheets(FileName & strWS).Cells(16, 3) = Sheets(FileName & strWS).Cells(16, 3) & Chr(10) & "Not logging to an external server."
                Call ColorWord(Sheets(FileName & strWS).Cells(16, 3), Sheets(FileName & strWS).Name, 16, "Not logging to an external server.")
                Call ColorWord(Sheets(FileName & strWS).Cells(16, 3), FileName & strWS, 16, "There are no logging servers set on this device.")
            Else
                Sheets(FileName & strWS).Cells(16, 3).Font.Color = 255
            End If
        End If
'SNMP Server Worksheet
        ActiveSheet.Cells(17, 3) = Sheets(FileName & " Analysis").Cells(18, 2).Value
        If Sheets(FileName & " Analysis").Cells(18, 2).Font.Color = 255 Then
            With ActiveSheet.Cells(17, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
        ElseIf InStr(1, ActiveSheet.Cells(17, 3), "version 2") > 0 Then
            With ActiveSheet.Cells(17, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
            Call ColorWord(Sheets(FileName & strWS).Cells(17, 3), Sheets(FileName & strWS).Name, 17, "version 2")
        ElseIf InStr(1, ActiveSheet.Cells(17, 3), "Public") > 0 Then
            With ActiveSheet.Cells(17, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
            Call ColorWord(Sheets(FileName & strWS).Cells(17, 3), Sheets(FileName & strWS).Name, 17, "Public")
        ElseIf Sheets(FileName & " Analysis").Cells(18, 2) <> "There is no SNMP Server associated with this device." Then
            With ActiveSheet.Cells(17, 2)
                .Value = "Pass"
                .Interior.Color = 5287936
                .Font.Color = 16777215
            End With
        End If
        If Sheets(FileName & strWS).Cells(17, 3) = "There is no SNMP Server associated with this device." Then
            With ActiveSheet.Cells(17, 2)
                .Font.Bold = True
                .Font.Color = 0
                .Value = "N/A"
                .Interior.Color = 14277081
            End With
        End If
'ROUTING PROTOCOLS Worksheet
        ActiveSheet.Cells(18, 3) = "See Appendix C"
        If Sheets(FileName & strRP).Cells(2, 1) <> "There are no routing protocols associated with this device." Then
            With ActiveSheet.Cells(18, 2)
                .Value = "Pass"
                .Interior.Color = 5287936
                .Font.Color = 16777215
            End With
        Else
            With ActiveSheet.Cells(18, 2)
                .Font.Bold = True
                .Font.Color = 0
                .Value = "N/A"
                .Interior.Color = 14277081
            End With
        End If
'VPN Worksheet Worksheet
        ActiveSheet.Cells(19, 3) = "See Appendix D"
        If Sheets(FileName & " Analysis").Cells(20, 2).Font.Color = 255 Then
            With ActiveSheet.Cells(19, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
        ElseIf Sheets(FileName & strVPN).Cells(2, 1) <> "There were no VPNs with this device." And Sheets(FileName & strWS).Cells(19, 2) <> "Fail" Then
            With Sheets(FileName & strWS).Cells(19, 2)
                .Font.Color = 0
                .Interior.Color = 65535
                .Value = "Check"
            End With
        Else
            With ActiveSheet.Cells(19, 2)
                .Value = "N/A"
                .Interior.Color = 14277081
            End With
        End If
        Set rng = Sheets(FileName & strVPN).Range("A:A").find(What:="3Des")
        If Not rng Is Nothing Then
            If Sheets(FileName & strWS).Cells(19, 3) <> "" Then
                Sheets(FileName & strWS).Cells(19, 3) = Sheets(FileName & strWS).Cells(19, 3) & Chr(10) & "3Des"
            Else
                Sheets(FileName & strWS).Cells(19, 3) = "3Des"
            End If
        End If
        Set rng = Sheets(FileName & strVPN).Range("A:A").find(What:="MD5")
        If Not rng Is Nothing Then
            If Sheets(FileName & strWS).Cells(19, 3) <> "" Then
                Sheets(FileName & strWS).Cells(19, 3) = Sheets(FileName & strWS).Cells(19, 3) & Chr(10) & "MD5"
            Else
                Sheets(FileName & strWS).Cells(19, 3) = "MD5"
            End If
        End If
        Set rng = Sheets(FileName & strVPN).Range("A:A").find(What:="SHA")
        If Not rng Is Nothing Then
            If Sheets(FileName & strWS).Cells(19, 3) <> "" Then
                Sheets(FileName & strWS).Cells(19, 3) = Sheets(FileName & strWS).Cells(19, 3) & Chr(10) & "SHA"
            Else
                Sheets(FileName & strWS).Cells(19, 3) = "SHA"
            End If
        End If
        Call ColorWord(Sheets(FileName & strWS).Cells(19, 3), FileName & strWS, 19, "3Des")
        Call ColorWord(Sheets(FileName & strWS).Cells(19, 3), FileName & strWS, 19, "MD5")
        Call ColorWord(Sheets(FileName & strWS).Cells(19, 3), FileName & strWS, 19, "SHA")
        
        Application.ScreenUpdating = False
'MAPS Worksheet
    ActiveSheet.Cells(20, 3) = Sheets(FileName & " Analysis").Cells(21, 2)
    If Sheets(FileName & " Maps").Cells(2, 1) <> "There are no Maps on this device." Then
        With ActiveSheet.Cells(20, 2)
            .Value = "Pass"
            .Interior.Color = 5287936
            .Font.Color = 16777215
        End With
    Else
        With ActiveSheet.Cells(20, 2)
            .Font.Bold = True
            .Font.Color = 0
            .Value = "N/A"
            .Interior.Color = 14277081
        End With
    End If
        
'Login Interfaces Worksheet
        Set rng = Sheets(FileName).Range("A:A").find(What:="line con 0")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & strWS).Cells(21, 3) = Trim(Sheets(FileName).Cells(y, 1))
            y = y + 1
            Do Until InStr(1, Sheets(FileName).Cells(y, 1), "!") > 0
                Sheets(FileName & strWS).Cells(21, 3) = Sheets(FileName & strWS).Cells(21, 3) & Chr(10) & Trim(Sheets(FileName).Cells(y, 1))
                y = y + 1
            Loop
        End If
        If InStr(1, Sheets(FileName & strWS).Cells(21, 3), "line con 0") > 0 Then
            With Sheets(FileName & strWS).Cells(21, 2)
                .Value = "Pass"
                .Interior.Color = 5287936
                .Font.Color = 16777215
            End With
        Else
            With Sheets(FileName & strWS).Cells(21, 2)
                .Value = "N/A"
                .Interior.Color = 14277081
            End With
            If Sheets(FileName & strWS).Cells(21, 3) = "N/A" Then Sheets(FileName & strWS).Cells(21, 3) = ""
        End If
        With Sheets(FileName & strWS).Range("A3:C24").Borders
            .LineStyle = xlContinuous
            .Color = vbBlack
            .Weight = xlThin
        End With
        x = 5
        Do Until x = 21
            If Sheets(FileName & strWS).Cells(x, 3) = "N/A" Then
                With Sheets(FileName & strWS).Cells(x, 2)
                    .Value = "N/A"
                    .Interior.Color = 14277081
                End With
            End If
            If Sheets(FileName & strWS).Cells(x, 3) = "N/A" Then Sheets(FileName & strWS).Cells(x, 3) = ""
            x = x + 1
        Loop
        x = 2
        If InStr(1, Sheets(FileName & strWS).Cells(21, 3), "telnet") > 0 Then
            Call ColorWord(Sheets(FileName & strWS).Cells(21, 3), Sheets(FileName & strWS).Name, 21, "telnet")
            With Sheets(FileName & strWS).Cells(21, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
        End If
'NAT tables Worksheet
        Set rng = Sheets(FileName).Range("A:A").find(What:="nat (")
        If Not rng Is Nothing Then
            y = rng.row
            blNAT = True
            Sheets.Add Sheets(FileName & strWS)
            ActiveSheet.Name = FileName & strNT
            ActiveSheet.Tab.Color = tabCol
            With ActiveSheet.Cells(1, 1)
                .Value = "Nat Tables"
                .Font.Bold = True
            End With
            x = 2
            ActiveSheet.Cells(x, 1) = Sheets(FileName).Cells(y, 1)
            y = y + 1
            x = x + 1
            Do Until rng Is Nothing
                Set rng = Sheets(FileName).Range("A" & y & ":A" & Sheets(FileName).UsedRange.Rows.Count).find(What:="nat (")
                If Not rng Is Nothing Then
                    y = rng.row
                    ActiveSheet.Cells(x, 1) = Sheets(FileName).Cells(y, 1)
                    y = y + 1
                    x = x + 1
                End If
            Loop
            Sheets(FileName & strWS).Cells(23, 3) = "See Appendix F"
        Else
            If WorksheetExists(FileName & strNT) = False Then
                Sheets.Add Sheets(FileName & strWS)
                ActiveSheet.Name = FileName & strNT
                ActiveSheet.Tab.Color = tabCol
                With ActiveSheet.Cells(1, 1)
                    .Value = "Nat Tables"
                    .Font.Bold = True
                End With
            Else
                Sheets(FileName & strNT).Activate
            End If
            ActiveSheet.Cells(2, 1) = "There were no NAT tables listed with this device."
            Sheets(FileName & strWS).Cells(23, 3) = "See Appendix F"
            With Sheets(FileName & strWS).Cells(22, 2)
                .Value = "N/A"
                .Interior.Color = 14277081
                .Font.Bold = True
            End With
            With Sheets(FileName & strWS).Cells(23, 2)
                .Value = "N/A"
                .Interior.Color = 14277081
            End With
        End If
        If ActiveSheet.Cells(2, 1) <> "There were no NAT tables listed with this device." Then
            With Sheets(FileName & strWS).Cells(22, 2)
                .Font.Bold = True
                .Interior.Color = 5287936
                .Font.Color = 16777215
                .Value = "Pass"
            End With
        End If
        x = 2
        Do Until x > Sheets(FileName & strNT).UsedRange.Rows.Count
            Application.DisplayAlerts = False
            With Sheets(FileName & strNT).Range("A" & x & ":H" & x)
                .MergeCells = True
                .WrapText = True
            End With
            x = x + 1
        Loop
'VLANs Worksheet
        If Sheets(FileName & " VLANs").Cells(2, 1) <> "No VLANs associated with this device." Then
            With Sheets(FileName & strWS).Cells(24, 2)
                .Font.Bold = True
                .Interior.Color = 5287936
                .Font.Color = 16777215
                .Value = "Pass"
            End With
            Sheets(FileName & strWS).Cells(24, 3) = "See Appendix G"
        Else
            With Sheets(FileName & strWS).Cells(24, 2)
                .Value = "N/A"
                .Interior.Color = 14277081
            End With
            Sheets(FileName & strWS).Cells(24, 3) = "See Appendix G"
        End If
        
'BUILD APPENDICES ON THE WORKSHEET
'Control Plane (Appendix A) Appendices
        Set sht = Sheets(FileName & strWS)
        sht.Activate
        x = sht.UsedRange.Rows.Count
        x = x + 3
        sht.Cells(x, 1).Select
        Selection.PageBreak = xlPageBreakManual
        sht.Range("A1:C1").Copy
        sht.Paste
        sht.Cells(Selection.row + 2, 1).Select
        x = Selection.row
        With Selection
            .Value = "Appendix A - Control Plane"
            .Font.Color = 9527094
            .Font.Bold = True
            .Font.Size = 16
        End With
        x = x + 1
        sht.Cells(x, 1).Select
        If blCP = True Then
            Sheets(FileName & strCP).Activate
            ActiveSheet.Cells(2, 1).Select
            used = Selection.End(xlDown).row
            ActiveSheet.Range("A2:A" & used).Copy
            sht.Paste
        Else
            sht.Cells(x, 1) = "There are no control plane settings on this device."
        End If
        Set rng = Sheets(FileName & strWS).Range("A:A").find(What:="VLANs")
        If Not rng Is Nothing Then
            y = rng.row + 4
            x = y
            Do Until Sheets(FileName & strWS).Cells(x, 1) <> ""
                x = x + 1
            Loop
            x = x - 2
            Sheets(FileName & strWS).Rows(y & ":" & x).EntireRow.Delete
        End If
            
'Access Lists (Appendix B) Appendices
        sht.Activate
        x = sht.UsedRange.Rows.Count
        sht.Cells(x + 3, 1).Select
        x = Selection.row + 1
        With Selection
            .Value = "Appendix B - Access Lists"
            .Font.Color = 9527094
            .Font.Bold = True
            .Font.Size = 16
        End With
        x = x + 1
        sht.Cells(Selection.row + 1, 1).Select
        If blAL = True Then
            Sheets(FileName & strAL).Activate
            ActiveSheet.Cells(2, 1).Select
            used = Selection.End(xlDown).row
            If used - ActiveSheet.UsedRange.Rows.Count > 5000 Then used = ActiveSheet.UsedRange.Rows.Count
            ActiveSheet.Range("A2:A" & used).Copy
            sht.Paste
        Else
            sht.Cells(x, 1) = "There are no Access Lists on this device."
        End If

'Routing Protocols (Appendix C) Appendices
        sht.Activate
        x = sht.UsedRange.Rows.Count
        sht.Cells(x + 3, 1).Select
        With Selection
            .Value = "Appendix C - Routing Protocols"
            .Font.Color = 9527094
            .Font.Bold = True
            .Font.Size = 16
        End With
        x = Selection.row + 1
        sht.Cells(Selection.row + 1, 1).Select
        If blRP = True Then
            Sheets(FileName & strRP).Activate
            ActiveSheet.Cells(2, 1).Select
            used = Selection.End(xlDown).row
            If ActiveSheet.UsedRange.Rows.Count - used > 5000 Then used = ActiveSheet.UsedRange.Rows
            ActiveSheet.Range("A2:A" & used).Copy
            sht.Paste
        Else
            sht.Cells(x, 1) = "There are no Routing Protocols on this device."
        End If
        
        Application.ScreenUpdating = False

'VPN-Encryption Appendix (Appendix D) Appendices
        Sheets(FileName & strWS).Activate
        x = Sheets(FileName & strWS).UsedRange.Rows.Count
        Sheets(FileName & strWS).Cells(x + 3, 1).Select
        With Selection
            .Value = "Appendix D - VPN-Encryption"
            .Font.Color = 9527094
            .Font.Bold = True
            .Font.Size = 16
        End With
        x = Selection.row + 1
        Sheets(FileName & strWS).Cells(Selection.row + 1, 1).Select
        If blVPN = True Then
            Sheets(FileName & strVPN).Activate
            ActiveSheet.Cells(2, 1).Select
            used = Selection.End(xlDown).row
            If used - ActiveSheet.UsedRange.Rows.Count > 5000 Then used = ActiveSheet.UsedRange.Rows.Count
            ActiveSheet.Range("A2:A" & used).Copy
            Sheets(FileName & strWS).Paste
        Else
            Sheets(FileName & strWS).Cells(x, 1) = "There are no VPNs on this device."
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="pptp")
        If Not rng Is Nothing Then
            With sht.Cells(19, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Font.Bold = True
            End With
            sht.Cells(19, 3) = Sheets(FileName & strWS).Cells(19, 3) & Chr(10) & "PPTP"
            sht.Activate
            Call ColorWord(Sheets(FileName & strWS).Cells(19, 3), FileName & strWS, 19, "PPTP")
        End If

'Maps (Appendix E) Appendices
        sht.Activate
        x = sht.UsedRange.Rows.Count
        sht.Cells(x + 3, 1).Select
        x = Selection.row + 1
        With Selection
            .Value = "Appendix E - Maps"
            .Font.Color = 9527094
            .Font.Bold = True
            .Font.Size = 16
        End With
        x = x + 1
        sht.Cells(Selection.row + 1, 1).Select
        If blMap = True Then
            Sheets(FileName & " Maps").Activate
            ActiveSheet.Cells(2, 1).Select
            used = Selection.End(xlDown).row
            If used - ActiveSheet.UsedRange.Rows.Count > 5000 Then used = ActiveSheet.UsedRange.Rows.Count
            ActiveSheet.Range("A2:A" & used).Copy
            sht.Paste
        Else
            sht.Cells(x, 1) = "There are no Maps on this device."
        End If

'NAT Tables (Appendix F) Appendices
        sht.Activate
        x = sht.UsedRange.Rows.Count
        sht.Cells(x + 3, 1).Select
        x = Selection.row + 1
        With Selection
            .Value = "Appendix F - NAT Tables"
            .Font.Color = 9527094
            .Font.Bold = True
            .Font.Size = 16
        End With
        x = x + 1
        sht.Cells(Selection.row + 1, 1).Select
        If blNAT = True Then
            Sheets(FileName & strNT).Activate
            ActiveSheet.Cells(2, 1).Select
            used = Selection.End(xlDown).row
            If used - ActiveSheet.UsedRange.Rows.Count > 5000 Then used = ActiveSheet.UsedRange.Rows.Count
            ActiveSheet.Range("A2:A" & used).Copy
            sht.Paste
        Else
            sht.Cells(x, 1) = "There were no NAT tables listed with this device."
        End If
        
        
        
        Set rng = Sheets(FileName & strWS).Range("A:A").find(What:="des")
        If Not rng Is Nothing Then
            y = rng.row
            If InStr(1, Sheets(FileName & strWS).Cells(y, 1), "-DES") > 0 Then
                With Sheets(FileName & strWS).Cells(20, 2)
                    .Font.Color = 16777215
                    .Interior.Color = 192
                    .Value = "Fail"
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Font.Bold = True
                End With
                Sheets(FileName & strWS).Cells(20, 3) = Sheets(FileName & strWS).Cells(20, 3) & Chr(10) & "des"
                Sheets(FileName & strWS).Activate
            End If
        End If
        Set rng = Sheets(FileName & strWS).Range("A:A").find(What:="3des")
        If Not rng Is Nothing Then
            With Sheets(FileName & strWS).Cells(20, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Font.Bold = True
            End With
            Sheets(FileName & strWS).Cells(20, 3) = Sheets(FileName & strWS).Cells(20, 3) & Chr(10) & "3des"
            Sheets(FileName & strWS).Activate
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="dh-group")
        If Not rng Is Nothing Then
            y = rng.row
            If CInt(Trim(Mid(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "dh-group") + 8, 2))) < 14 Then
                With Sheets(FileName & strWS).Cells(20, 2)
                    .Font.Color = 16777215
                    .Interior.Color = 192
                    .Value = "Fail"
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Font.Bold = True
                End With
                Sheets(FileName & strWS).Cells(20, 3) = Sheets(FileName & strWS).Cells(20, 3) & Chr(10) & "Diffie-Hellman Group" & Trim(Mid(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "dh-group") + 8, 2))
                Sheets(FileName & strWS).Activate
            End If
        End If
        If InStr(1, FileName, "Sean") = 0 And y <> 0 Then
            Call ColorWord(Sheets(FileName & strWS).Cells(20, 3), FileName & strWS, 20, "des")
            Call ColorWord(Sheets(FileName & strWS).Cells(20, 3), FileName & strWS, 20, "3des")
            Call ColorWord(Sheets(FileName & strWS).Cells(20, 3), FileName & strWS, 20, "Diffie-Hellman Group" & Trim(Mid(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "dh-group") + 8, 2)))
        End If

'VLANs (Appendix G) Appendices
        sht.Activate
        x = sht.UsedRange.Rows.Count
        sht.Cells(x + 3, 1).Select
        x = Selection.row + 1
        With Selection
            .Value = "Appendix G - VLANs"
            .Font.Color = 9527094
            .Font.Bold = True
            .Font.Size = 16
        End With
        sht.Cells(Selection.row + 1, 1).Select
        If blVLAN = True Then
            Sheets(FileName & " VLANs").Activate
            ActiveSheet.Cells(2, 1).Select
            used = Selection.End(xlDown).row
            If used - ActiveSheet.UsedRange.Rows.Count > 5000 Then used = ActiveSheet.UsedRange.Rows.Count
            ActiveSheet.Range("A2:A" & used).Copy
            sht.Paste
        Else
            sht.Cells(x, 1) = "There are no VLANs on this device."
        End If

        Set rng = Sheets(FileName & strWS).Range("A:A").find(What:="VLANs")
        If Not rng Is Nothing Then
            y = rng.row + 4
            x = y
            Do Until Sheets(FileName & strWS).Cells(x, 1) <> ""
                x = x + 1
            Loop
            x = x - 2
            Sheets(FileName & strWS).Rows(y & ":" & x).EntireRow.Delete
        End If
'RowHeight for Appendices
        x = 28
        used = Sheets(FileName & strWS).UsedRange.Rows.Count
        Sheets(FileName & strWS).Activate
        Application.DisplayAlerts = False
        Do Until x > used Or x > 1000
            Sheets(FileName & strWS).Range("A" & x & ":C" & x).MergeCells = True
            Sheets(FileName & strWS).Range("A" & x & ":C" & x).WrapText = True
            Select Case Len(Sheets(FileName & strWS).Cells(x, 1))
                Case Is > 252
                    lngRowHeight = 60
                    Sheets(FileName & strWS).Rows(x).RowHeight = lngRowHeight
                Case Is > 168
                    lngRowHeight = 45
                    Sheets(FileName & strWS).Rows(x).RowHeight = lngRowHeight
                Case Is > 84
                    lngRowHeight = 30
                    Sheets(FileName & strWS).Rows(x).RowHeight = lngRowHeight
            End Select
            x = x + 1
        Loop
        Sheets(FileName & strWS).Cells(1, 1).Select
        
'Move and Format Files
        If FileName = "" Then GoTo NextFile2
        Sheets(FileName & " Analysis").Move After:=Sheets(FileName)
        Sheets(FileName & strWS).Range("B:C").VerticalAlignment = xlCenter
        Sheets(FileName & strCP).Move After:=Sheets(FileName & " Analysis")
        Sheets(FileName & strAL).Move After:=Sheets(FileName & strCP)
        If Len(FileName & strRP) <= 31 Then
            Sheets(FileName & strRP).Move After:=Sheets(FileName & strAL)
            Sheets(FileName & strVPN).Move After:=Sheets(FileName & strRP)
        Else
            Sheets(FileName & strRP).Move After:=Sheets(FileName & strAL)
            Sheets(FileName & strVPN).Move After:=Sheets(FileName & strRP)
        End If
        Sheets(FileName & " Maps").Move After:=Sheets(FileName & strVPN)
        Sheets(FileName & strNT).Move After:=Sheets(FileName & " Maps")
        Sheets(FileName & " VLANs").Move After:=Sheets(FileName & strNT)
NextFile:
        blCP = False
        blMap = False
        blAL = False
        blVPN = False
        FileName = Dir
        z = z + 1
        strUser = ""
        tabCol = tabCol + 13000
        FileCnt = FileCnt - 1
        If FileCnt = 0 Then FileName = ""
   Loop
    
    
    For Each sht In Sheets
        If InStr(1, sht.Name, "Sheet") > 0 Then sht.Delete
    Next sht
    
    Call CountIssues
    
    Application.ScreenUpdating = False
    

    
NextFile2:
    
    On Error Resume Next
    Sheets("STARTER TAB").Activate
    ActiveSheet.Columns(1).Delete
    ActiveSheet.Shapes("cmdAnalyzeConfigs").Delete
    ActiveSheet.Rows("26:27").Delete
    ActiveSheet.Cells(1, 1) = "Unsupported Hosts"
    ActiveSheet.Cells(1, 2) = "Unsupported OS"
    ActiveSheet.Cells(1, 3) = "Host Vulnerabilities"
    
'Add Appendices to the Worksheet tabs

    ActiveWindow.ScrollRow = 1
    
    Sheets("STARTER TAB").Shapes("cmdCustomerPDF").Visible = True
    Sheets("STARTER TAB").Range("A30:A31").Interior.Color = 255
    ActiveSheet.Shapes.Range(Array("cmdCustomerPDF")).Select
    ActiveSheet.Shapes("cmdCustomerPDF").IncrementLeft -8.4782677165
    ActiveSheet.Shapes("cmdCustomerPDF").IncrementTop 30.6521259843
    ActiveSheet.Cells(1, 1).Select
    On Error GoTo 0
    
'Add Summary Page
    Call SummaryPage
    
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .AskToUpdateLinks = True
    End With
    Application.StatusBar = ""
    
    For Each wkbk In Workbooks
        If InStr(1, Right(wkbk.Name, 17), "Dec.13") > 0 Then wkbk.Close False
    Next wkbk
    
    wbMain.Save
    
    MsgBox ("Done")
      
End Sub

 

[Dad_x6]

And the second half...

Function ExtractNumbers(CellVal As String, lenCell As Integer) As Integer
    Dim Rnj As Range, cellLngth As Integer, numPosition As Integer, strTarget As String
    
    strTarget = ""
    
    For numPosition = 1 To lenCell
        If IsNumeric(Mid(CellVal, numPosition, 1)) Then
            strTarget = strTarget & Mid(CellVal, numPosition, 1)
        End If
    Next numPosition
    ExtractNumbers = Len(strTarget) + 11
End Function

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function


Function StripChar(Txt As String) As Variant
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "\D"
    StripChar = Val(.Replace(Txt, " "))
End With
End Function

Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    Dim i
    For i = LBound(arr) To UBound(arr)
        If arr(i) = stringToBeFound Then
            IsInArray = True
            Exit Function
        Else
            IsInArray = False
        End If
    Next i
    

End Function


Function CheckIfSheetExists(SheetName As String) As Boolean
    Dim WS As Worksheet
    CheckIfSheetExists = False
    For Each WS In Worksheets
      If SheetName = WS.Name Then
        CheckIfSheetExists = True
        Exit Function
      End If
    Next WS
End Function


Function CountFiles(Path As String)
    Dim FullPath As String
    Dim FileName As String
        FileName = Dir(Path & "*.txt")
    Dim xCount As Integer
        xCount = 0
    
    Do While FileName <> ""
        xCount = xCount + 1
        FileName = Dir()
    Loop
    
    FileName = Dir(Path & "*.log")
    Do While FileName <> ""
        xCount = xCount + 1
        FileName = Dir()
    Loop
    
    CountFiles = xCount
End Function

Public Function RegExx(cell As String) As Boolean
    Dim regexObject As RegExp
        Set regexObject = CreateObject("VBScript.RegExp")
    Dim str As String
    
    regexObject.Pattern = "\b(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\."
    
    If regexObject.Test(cell) = True Then RegExx = True
    
End Function

Public Sub Analysis()
'Hostname Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="hostname")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(2, 2) = Trim(Mid(Sheets(FileName).Cells(y, 1), 9, 50))
        End If
        y = 0
'Username Initial
         Set rng = Sheets(FileName).Range("A:A").find(What:="username")
         i = 0
         If Not rng Is Nothing Then
            y = rng.row
            strUser = Mid(Sheets(FileName).Cells(y, 1), 10, 50)
            If InStr(1, strUser, " ") > 0 Then
                strUser = Left(strUser, InStr(1, strUser, " ") - 1)
            End If
            Sheets(FileName & " Analysis").Cells(3, 2) = strUser
            Do Until rng Is Nothing Or i = 51
                Set rng = Sheets(FileName).Range("A" & y + 1 & ":A" & Sheets(FileName).UsedRange.Rows.Count).find(What:="username")
                If Not rng Is Nothing Then
                    y = rng.row
                    strUser = strUser & Mid(Sheets(FileName).Cells(y, 1), 10, 50)
'                    strUser = Left(strUser, InStr(1, strUser, " ") - 1)
                    If InStr(1, strUser, " ") > 0 Then
                        strUser = Left(strUser, InStr(1, strUser, " ") - 1)
                    End If
                    If strUser <> strOrigUser Then Sheets(FileName & " Analysis").Cells(3, 2) = Sheets(FileName & " Analysis").Cells(3, 2) & Chr(10) & strUser
                    strOrigUser = strUser
                End If
                strUser = ""
                i = i + 1
            Loop
            If strUser <> "" Then
                Sheets(FileName & " Analysis").Cells(3, 2) = Sheets(FileName & " Analysis").Cells(3, 2) & Chr(10) & strUser
            Else
                Sheets(FileName & " Analysis").Cells(3, 2) = "There are no users in the config file – see login interfaces below"
            End If
        End If
'PWD Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="PWD")
        If Not rng Is Nothing Then
            y = rng.row
            If Sheets(FileName).Cells(y, 1) = "PWD" Then Sheets(FileName & " Analysis").Cells(4, 2) = Sheets(FileName).Cells(y, 3)
            Set rng = Nothing
        Else
            Set rng = Sheets(FileName).Range("A:A").find(What:="password")
            If Not rng Is Nothing Then
                y = rng.row
                Sheets(FileName & " Analysis").Cells(4, 2) = Sheets(FileName).Cells(y, 3)
            End If
        End If
        y = 0
'Software Version Initial
        Dim strComma As String
        
        Set rng = Sheets(FileName).Range("A:A").find(What:="SW:")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(5, 2) = Trim(Mid(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "SW:") + 4, 50))
        End If
        If rng Is Nothing Then
            Set rng = Sheets(FileName).Range("A:A").find(What:=", Version")
            If Not rng Is Nothing Then
                y = rng.row
'                If InStr(1, Sheets(FileName).Cells(y, 1), "show version") = 0 Then
'                    yOrig = y
'                        Sheets(FileName & " Analysis").Cells(5, 2) = Sheets(FileName).Cells(y, 1)
'                End If
                strComma = Trim(Mid(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "Version") + 8, 10))
                If InStr(1, strComma, ",") > 0 Then
                    strComma = Left(strComma, InStr(1, strComma, ",") - 1)
                ElseIf InStr(1, strComma, "[") > 0 Then
                    strComma = Left(strComma, InStr(1, strComma, "[") - 1)
                End If
                Sheets(FileName & " Analysis").Cells(5, 2) = strComma
            End If
        End If
        If rng Is Nothing Then
            Set rng = Sheets(FileName).Range("A:A").find(What:="Software")
            If Not rng Is Nothing Then
                y = rng.row
                Sheets(FileName & " Analysis").Cells(5, 2) = Trim(Sheets(FileName).Cells(y, 1))
            End If
        End If
        If rng Is Nothing Then
            Set rng = Sheets(FileName).Range("A:A").find(What:="SW version")
            If Not rng Is Nothing Then
                y = rng.row
                Sheets(FileName & " Analysis").Cells(5, 2) = Trim(Mid(Sheets(FileName).Cells(y, 1), 12, 50))
            End If
        End If
        If rng Is Nothing Then
            Set rng = Sheets(FileName).Range("A:A").find(What:="IOS")
            If Not rng Is Nothing Then
                y = rng.row
                If y < yOrig Then
                    Sheets(FileName & " Analysis").Cells(5, 2) = Trim(Sheets(FileName).Cells(y, 1))
                End If
            End If
        End If
        If rng Is Nothing Then
            x = 5
            Do Until x = 30
                If InStr(1, LCase(Sheets(FileName).Cells(x, 1)), "version") > 0 Or InStr(1, LCase(Sheets(FileName).Cells(x, 1)), "ios") > 0 Or InStr(1, LCase(Sheets(FileName).Cells(x, 1)), "software") > 0 Then
                    y = x
                    Sheets(FileName & " Analysis").Cells(5, 2) = Sheets(FileName).Cells(y, 1)
                    Exit Do
                End If
                x = x + 1
            Loop
        End If
        y = 0
'Hardware Initial (Model)
        Set rng = Nothing
        Set rng = Sheets(FileName).Range("A:A").find(What:="HW:")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(6, 2) = Trim(Mid(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "HW:") + 4, 50))
            Set rng = Nothing
        End If
        If rng Is Nothing Then
            Set rng = Sheets(FileName).Range("A:A").find(What:="System Type:")
            If Not rng Is Nothing Then
                y = rng.row
                Sheets(FileName & " Analysis").Cells(6, 2) = Trim(Mid(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "Software Version:") + 13, 50))
                Set rng = Nothing
            End If
        End If
        If rng Is Nothing Then
            Dim intColon As Integer
            Set rng = Sheets(FileName).Range("A:A").find(What:="Model Number")
            If Not rng Is Nothing Then
                y = rng.row
                intColon = InStr(1, Sheets(FileName).Cells(y, 1), ":")
                Sheets(FileName & " Analysis").Cells(6, 2) = Trim(Mid(Sheets(FileName).Cells(y, 1), intColon + 1, 50))
            Else
                Sheets(FileName & " Analysis").Cells(6, 2) = "Not found"
            End If
        End If
        If rng Is Nothing Then
            Set rng = Sheets(FileName).Range("A:A").find(What:="System Type:")
            If Not rng Is Nothing Then
                y = rng.row
                Sheets(FileName & " Analysis").Cells(6, 2) = Trim(Mid(Sheets(FileName).Cells(y, 1), 13, 50))
                Set rng = Nothing
            Else
                Sheets(FileName & " Analysis").Cells(6, 2) = "Not found"
            End If
        End If
        If rng Is Nothing Then
            Set rng = Sheets(FileName).Range("A:A").find(What:="HW version")
            If Not rng Is Nothing Then
                y = rng.row
                Sheets(FileName & " Analysis").Cells(6, 2) = Trim(Mid(Sheets(FileName).Cells(y, 1), 12, 50))
            End If
        End If
                
        y = 0
'Uptime Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="uptime is")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(7, 2) = Mid(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "uptime is") + 10, 100)
            Set rng = Nothing
        End If
        y = 0
'Arp/Exec Timeout Initial

'NTP Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="ntp server")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(9, 2) = Trim(Mid(Sheets(FileName).Cells(y, 1), 11, 50))
            If Left(Sheets(FileName).Cells(y + 1, 1), 6) = Left(Sheets(FileName).Cells(y, 1), 6) Then
                Sheets(FileName & " Analysis").Cells(9, 2) = Sheets(FileName & " Analysis").Cells(9, 2) & "   "
                Sheets(FileName & " Analysis").Cells(9, 2) = Sheets(FileName & " Analysis").Cells(9, 2) & Sheets(FileName).Cells(y + 1, 1)
            End If
            Set rng = Nothing
        End If
        If Sheets(FileName & " Analysis").Cells(9, 2) = "" Then
            If InStr(1, Sheets(FileName).Cells(y + 1, 1), "server") > 0 Then
                y = y + 1
                Do Until InStr(1, Sheets(FileName).Cells(y, 1), "server") = 0
                    Sheets(FileName & " Analysis").Cells(9, 2) = Sheets(FileName).Cells(y, 1)
                    y = y + 1
                Loop
            End If
        End If
        If Sheets(FileName & " Analysis").Cells(9, 2) = "" Then
            Sheets(FileName & " Analysis").Cells(9, 2) = "There are no NTP Servers specified for this device."
        End If
        y = 0
'Users -Groups: Initial
        On Error Resume Next
        Set rng = Sheets(FileName).Range("A:A").find(What:="password 5")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(10, 2) = Left(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "password 5") + 10)
            Sheets(FileName & " Analysis").Cells(10, 2).Font.Color = 255
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="password 7")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(10, 2) = Left(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "password 7") + 10)
            Sheets(FileName & " Analysis").Cells(10, 2).Font.Color = 255
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="password 0")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(10, 2) = Left(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "password 0") + 10)
            Sheets(FileName & " Analysis").Cells(10, 2).Font.Color = 255
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="secret 5")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(10, 2) = Left(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "secret 5") + 8)
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="secret 7")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(10, 2) = Left(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "secret 7") + 8)
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="secret 9")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(10, 2) = Left(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "secret 9") + 8)
        End If
        y = 0
        i = 0
        Set rng = Sheets(FileName).Range("A:A").find(What:="username")
        If Not rng Is Nothing Then
            y = rng.row
            strOrigUser = Sheets(FileName).Cells(y, 1)
            If Sheets(FileName & " Analysis").Cells(10, 2) <> "" Then
                If InStr(1, Sheets(FileName).Cells(y + 1, 1), "password") = 0 Then
                    Sheets(FileName & " Analysis").Cells(10, 2) = Sheets(FileName & " Analysis").Cells(10, 2) & Chr(10) & Sheets(FileName).Cells(y, 1)
                ElseIf InStr(1, Sheets(FileName).Cells(y + 1, 1), "password") <> 0 And InStr(1, Sheets(FileName).Cells(y, 1), "password") = 0 Then
                    Sheets(FileName & " Analysis").Cells(10, 2) = Sheets(FileName & " Analysis").Cells(10, 2) & Chr(10) & Sheets(FileName).Cells(y, 1) & " " & Mid(Sheets(FileName).Cells(y + 1, 1), 2, 11)
                Else
                    Sheets(FileName & " Analysis").Cells(10, 2) = Sheets(FileName & " Analysis").Cells(10, 2) & Chr(10) & Left(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "password") + 10)
                End If
            Else
                Sheets(FileName & " Analysis").Cells(10, 2) = Left(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "password") - 1)
            End If
'            i = 0
'            y = y + 1
            Do Until rng Is Nothing Or i = 51
                Set rng = Sheets(FileName).Range("A" & y & ":A" & Sheets(FileName).UsedRange.Rows.Count).find(What:="username")
                If Not rng Is Nothing Then
                    y = rng.row
                    If strOrigUser <> Sheets(FileName).Cells(y, 1) Then
                        strOrigUser = Sheets(FileName).Cells(y, 1)
                        If Sheets(FileName & " Analysis").Cells(10, 2) <> "" Then
                            If InStr(1, Sheets(FileName).Cells(y, 1), "privilege") > 0 Then
                                Sheets(FileName & " Analysis").Cells(10, 2) = Sheets(FileName & " Analysis").Cells(10, 2) & Chr(10) & Left(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "password") + 10)
                            Else
                                Sheets(FileName & " Analysis").Cells(10, 2) = Sheets(FileName & " Analysis").Cells(10, 2) & Chr(10) & Sheets(FileName).Cells(y, 1) & " " & Trim(Mid(Sheets(FileName).Cells(y + 1, 1), 2, 10))
                            End If
                        Else
                            Sheets(FileName & " Analysis").Cells(10, 2) = Left(Sheets(FileName).Cells(y, 1), InStr(1, Sheets(FileName).Cells(y, 1), "password") + 9)
                        End If
                    End If
                    i = i + 1
                End If
            Loop
        End If
        
Clock:
        On Error GoTo 0
'Clock Timezone Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="Clock Timezone")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(11, 2) = Trim(Mid(Sheets(FileName).Cells(y, 1), 16, 25))
        Else
            Sheets(FileName & " Analysis").Cells(11, 2) = "A timezone is not set on this device."
            Sheets(FileName & " Analysis").Cells(11, 2).Font.Color = 255
        End If
        y = 0
'Banner Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="banner")
        If Not rng Is Nothing Then
            y = rng.row
            i = 1
            Do Until InStr(1, Sheets(FileName).Cells(y + i, 1), "*") = 0
                strBanner = strBanner + Sheets(FileName).Cells(y + i, 1) & Chr(10)
                If InStr(1, strBanner, "banner motd ") > 0 Then strBanner = Replace(strBanner, "banner motd ", "")
                i = i + 1
            Loop
            Sheets(FileName & " Analysis").Cells(12, 2) = strBanner
        Else
            Set rng = Sheets(FileName).Range("A:A").find(What:="banner")
            If Not rng Is Nothing Then
                y = rng.row
                i = 1
                Do Until InStr(1, Sheets(FileName).Cells(y + i, 1), "*") = 0
                    strBanner = strBanner + Sheets(FileName).Cells(y + i, 1) & Chr(10)
                    If InStr(1, strBanner, "banner motd ") > 0 Then strBanner = Replace(strBanner, "banner motd ", "")
                    i = i + 1
                Loop
                Sheets(FileName & " Analysis").Cells(12, 2) = strBanner
            End If
        End If
        If Sheets(FileName & " Analysis").Cells(12, 2) = "" Then
            Sheets(FileName & " Analysis").Cells(12, 2) = "There is no banner set on this device."
            Sheets(FileName & " Analysis").Cells(12, 2).Font.Color = 255
        End If
        y = 0
        strBanner = ""
'Radius AAA Server and Tacacs Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="AAA Server")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(13, 2) = "AAA Server"
        Else
            Set rng = Sheets(FileName).Range("A:A").find(What:="Tacacs")
            If Not rng Is Nothing Then
                y = rng.row
                Sheets(FileName & " Analysis").Cells(13, 2) = "Tacacs Server"
            Else
                Sheets(FileName & " Analysis").Cells(13, 2) = "There is no AAA server or Tacacs set on this device."
            End If
        End If
        y = 0
'Control Plane Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="control-plane")
        If Not rng Is Nothing Then
            y = rng.row
            blCP = True
            Sheets(FileName & " Analysis").Cells(14, 2) = "See Appendix A"
            Sheets.Add Sheets(FileName & strWS)
            ActiveSheet.Name = FileName & strCP
            ActiveSheet.Tab.Color = tabCol
            With ActiveSheet.Cells(1, 1)
                .Value = "Control Planes"
                .Font.Bold = True
            End With
            a = y
            Do Until aBool = True Or InStr(1, Sheets(FileName).Cells(a + ai, 1), "end") > 0
                If InStr(1, Sheets(FileName).Cells(a + ai, 1), "!") > 0 Then
                    aCnt = aCnt + 1
                    GoTo NextTry
                Else
                    Sheets(FileName & strCP).Cells(CPR, 1) = Sheets(FileName).Cells(a + ai, 1)
                    aCnt = 0
                    CPR = CPR + 1
                End If
NextTry:
                ai = ai + 1
                If aCnt = 4 Then Exit Do
            Loop
        Else
            Sheets(FileName & " Analysis").Cells(14, 2) = "See Appendix A"
            If Len(FileName & strCP) > 30 Then strCP = "CP"
            Sheets.Add Sheets(FileName & strWS)
            ActiveSheet.Name = FileName & strCP

            With ActiveSheet.Cells(1, 1)
                .Font.Bold = True
                .Value = "Control Planes"
            End With
            ActiveSheet.Tab.Color = tabCol
            ActiveSheet.Cells(2, 1) = "There were no Control Planes listed with this host."
            
        End If
        y = 0
        CPR = 2
        aCnt = 0
        ai = 1
        ActiveSheet.Range("A:A").Columns.AutoFit
        Sheets(FileName & " Analysis").Activate
        Do Until x > Sheets(FileName & strCP).UsedRange.Rows.Count
            Application.DisplayAlerts = False
            With Sheets(FileName & strCP).Range("A" & x & ":H" & x)
                .MergeCells = True
                .WrapText = True
            End With
            x = x + 1
        Loop
'Routing Protocols Initial
        If Len(FileName & " Routing Protocols") <= 30 Then
            strRP = " Routing Protocols"
        ElseIf Len(FileName & " Routing Prot") <= 30 Then
            strRP = " Routing Prot"
        Else
            strRP = " RP"
        End If
        If WorksheetExists(FileName & strRP) = False Then
            Sheets.Add , ActiveSheet
            ActiveSheet.Name = FileName & strRP
            ActiveSheet.Tab.Color = tabCol
            With ActiveSheet.Cells(1, 1)
                .Font.Bold = True
                .Value = "Routing Protocols"
            End With
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="router ospf 1")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & strRP).Cells(2, 1) = rng.Value
            y = y + 1
            Do Until InStr(1, Sheets(FileName).Cells(y, 1), "!") > 0
                Sheets(FileName & strRP).Cells(Sheets(FileName & strRP).UsedRange.Rows.Count + 1, 1) = Sheets(FileName).Cells(y, 1)
                y = y + 1
            Loop
        Else
            Sheets(FileName & strRP).Cells(2, 1) = "There are no routing protocols associated with this device."
        End If
'SSH Server Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="SSH Server")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(15, 2) = True
        Else
            Sheets(FileName & " Analysis").Cells(15, 2) = "N/A"
        End If
        y = 0
'SSH Timeout Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="ssh timeout")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(16, 2) = Trim(Sheets(FileName).Cells(y, 1))
        Else
            Set rng = Sheets(FileName).Range("A:A").find(What:="ssh timeout")
            If Not rng Is Nothing Then
                y = rng.row
                Sheets(FileName & " Analysis").Cells(16, 2) = Trim(Sheets(FileName).Cells(y, 1))
            End If
        End If
        y = 0
'Logging Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="logging")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(17, 2) = Sheets(FileName).Cells(y, 1)
            strLog = Sheets(FileName).Cells(y, 1)
            y = y + 1
            Do Until rng Is Nothing
                Set rng = Sheets(FileName).Range("A" & y & ":A" & Sheets(FileName).UsedRange.Rows.Count).find(What:="logging")
                If Not rng Is Nothing Then
                    y = rng.row
                    If strLog <> Sheets(FileName).Cells(y, 1) Then
                        Sheets(FileName & " Analysis").Cells(17, 2) = Sheets(FileName & " Analysis").Cells(17, 2) & Chr(10) & Sheets(FileName).Cells(y, 1)
                        strLog = Sheets(FileName).Cells(y, 1)
                    Else
                        y = y + 1
                    End If
                    'y = y + 1
                End If
            Loop
        Else
            Sheets(FileName & " Analysis").Cells(17, 2) = "There are no logging servers set on this device."
            Sheets(FileName & " Analysis").Cells(17, 2).Font.Color = 255
        End If
        y = 0
'SNMP Server Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="snmp-server")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(18, 2) = Sheets(FileName).Cells(y, 1)
            y = y + 1
            Do Until InStr(1, Sheets(FileName).Cells(y, 1), "snmp-server") = 0
                Sheets(FileName & " Analysis").Cells(18, 2) = Sheets(FileName & " Analysis").Cells(18, 2) & Chr(10) & Sheets(FileName).Cells(y, 1)
                y = y + 1
            Loop
        Else
            Sheets(FileName & " Analysis").Cells(18, 2) = "There is no SNMP Server associated with this device."
        End If
        y = 0
'VPN-ENCRYPTION Initial
        If FileName = "R16-DISD-3400G-CO" Then strVPN = " VPN-Encrypt"
        If WorksheetExists(FileName & strVPN) = False Then
            Sheets.Add ActiveSheet
            ActiveSheet.Name = FileName & strVPN
            ActiveSheet.Tab.Color = tabCol
            With ActiveSheet.Cells(1, 1)
                .Value = "VPN-Encryption"
                .Font.Bold = True
            End With
        End If
        Set rng = Sheets(FileName).Range("A:A").find(What:="vpn")
        If Not rng Is Nothing Then
            y = rng.row
            strVPN2 = Sheets(FileName).Cells(y, 1)
            blVPN = True
            Sheets(FileName & strVPN).Cells(2, 1) = Sheets(FileName).Cells(y, 1)
            used = Sheets(FileName).UsedRange.Rows.Count
            y = 1
            Sheets(FileName & strVPN).Activate
            For b = 2 To 50
                Set rng = Sheets(FileName).Range("A" & y & ":A" & Sheets(FileName).UsedRange.Rows.Count).find(What:="vpn")
                If Not rng Is Nothing Then
                    y = rng.row
                    strVPN2 = Sheets(FileName).Cells(y, 1)
                    If Sheets(FileName).Cells(y, 1) <> strVPN2 Then
                        If InStr(1, Sheets(FileName).Cells(y, 1), FileName) = 0 Then
                            Sheets(FileName & strVPN).Cells(Sheets(FileName & strVPN).UsedRange.Rows.Count + 1, 1) = Sheets(FileName).Cells(y, 1)
                        End If
                    End If
                End If
            Next b
        End If
       ' If InStr(1, FileName, "VOIP") > 0 Then Stop
       used = Sheets(FileName).UsedRange.Rows.Count
        Set rng = Sheets(FileName).Range("A:A").find(What:="crypto")
        If Not rng Is Nothing Then
            y = rng.row
            strVPN2 = Sheets(FileName).Cells(y, 1)
            For b = Sheets(FileName & strVPN).UsedRange.Rows.Count To Sheets(FileName & strVPN).UsedRange.Rows.Count + 50
                Set rng = Sheets(FileName).Range("A" & y & ":A" & used).find(What:="crypto")
                If Not rng Is Nothing Then
                    y = rng.row
                    If Sheets(FileName).Cells(y, 1) <> strVPN2 Then
                        Sheets(FileName & strVPN).Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1) = Sheets(FileName).Cells(y, 1)
                        strVPN2 = Sheets(FileName).Cells(y, 1)
                    End If
                End If
            Next b
        End If
        Do Until x > Sheets(FileName & strVPN).UsedRange.Rows.Count
            Application.DisplayAlerts = False
            With Sheets(FileName & strVPN).Range("A" & x & ":H" & x)
                .MergeCells = True
                .WrapText = True
            End With
            x = x + 1
        Loop
        Sheets(FileName & " Analysis").Cells(20, 2) = "See Appendix D"
        If Sheets(FileName & strVPN).Cells(2, 1) = "" Or Sheets(FileName & strVPN).Cells(2, 1) = "There were no VPNs with this device." Then
            Sheets(FileName & " Analysis").Cells(20, 2) = "See Appendix D"
            Sheets(FileName & strVPN).Cells(2, 1) = "There were no VPNs with this device."
        End If
        y = 0
'Telnet Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="telnet")
        If Not rng Is Nothing Then
            Sheets(FileName & " Analysis").Cells(22, 2) = "True"
            Sheets(FileName & " Analysis").Cells(22, 2).Font.Color = 255
            Set rng = Nothing
        Else
            Sheets(FileName & " Analysis").Cells(22, 2) = "False"
        End If
        y = 0
'Telnet Time Out Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="Telnet Timeout")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(23, 2) = Sheets(FileName).Cells(y, 1)
            Sheets(FileName & " Analysis").Cells(23, 2).Font.Color = 255
        End If
        y = 0
'Firewall Any Any Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="any any")
        If Not rng Is Nothing Then
            y = rng.row
            Sheets(FileName & " Analysis").Cells(24, 2) = Trim(Sheets(FileName).Cells(y, 1))
            Sheets(FileName & " Analysis").Cells(24, 2).Font.Color = 255
        End If
        Sheets(FileName & " Analysis").Activate
        Sheets(FileName & " Analysis").Range("A:B").HorizontalAlignment = xlLeft
        Sheets(FileName & " Analysis").Cells(1, 1).Select
'Access Lists Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="access-list")
        If Not rng Is Nothing Then
            y = rng.row
            blAL = True
            Sheets(FileName & " Analysis").Cells(25, 2) = "See Appendix B"
            i = 1
            Sheets.Add , ActiveSheet
            ActiveSheet.Name = FileName & strAL
            ActiveSheet.Tab.Color = tabCol
            With ActiveSheet.Cells(1, 1)
                .Value = "Access Lists"
                .Font.Bold = True
            End With
            used = Sheets(FileName).UsedRange.Rows.Count
            x = 2
            Do Until InStr(1, Sheets(FileName).Cells(y, 1), "!") > 0
                Sheets(FileName & strAL).Cells(x, 1) = Sheets(FileName).Cells(y, 1)
                x = x + 1
                y = y + 1
            Loop
            Set rng = Sheets(FileName).Range("A" & y + 1 & ":A" & Sheets(FileName).UsedRange.Rows.Count).find(What:="access-list")
            If Not rng Is Nothing Then
                y = rng.row
                Do Until InStr(1, Sheets(FileName).Cells(y, 1), "!") > 0
                    Sheets(FileName & strAL).Cells(x, 1) = Sheets(FileName).Cells(y, 1)
                    x = x + 1
                    y = y + 1
                Loop
            End If
        Else
            Sheets.Add , ActiveSheet
            ActiveSheet.Name = FileName & strAL
            ActiveSheet.Tab.Color = tabCol
            With ActiveSheet.Cells(1, 1)
                .Value = "Access Lists"
                .Font.Bold = True
            End With
            ActiveSheet.Cells(2, 1) = "There were no Access Lists listed with this device."
        End If
        y = 0
        ActiveSheet.Range("A:A").Columns.AutoFit
        Sheets(FileName & " Analysis").Activate
        AL = 2
        Do Until x > Sheets(FileName & strAL).UsedRange.Rows.Count
            Application.DisplayAlerts = False
            With Sheets(FileName & strAL).Range("A" & x & ":H" & x)
                .MergeCells = True
                .WrapText = True
            End With
            x = x + 1
        Loop
'Maps Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="map")
        If Not rng Is Nothing Then
            y = rng.row
            blMap = True
            i = 1
            Sheets.Add , ActiveSheet
            With ActiveSheet
                .Tab.Color = tabCol
                .Name = FileName & " Maps"
            End With
            ActiveSheet.Cells(1, 1) = "Maps"
            ActiveSheet.Cells(1, 1).Font.Bold = True
            used = Sheets(FileName).UsedRange.Rows.Count
            Do Until y > used
                If InStr(1, Sheets(FileName).Cells(y, 1), "map") > 0 Then
                    ActiveSheet.Cells(xMap, 1) = Sheets(FileName).Cells(y, 1)
                    xMap = xMap + 1
                End If
                y = y + 1
            Loop
            Sheets(FileName & " Analysis").Cells(21, 2) = "See Appendix E"
            used = 0
            xMap = 2
            Sheets(FileName & " Analysis").Activate
        Else
            Sheets.Add , ActiveSheet
            With ActiveSheet
                .Tab.Color = tabCol
                .Name = FileName & " Maps"
            End With
            ActiveSheet.Cells(1, 1) = "Maps"
            ActiveSheet.Cells(1, 1).Font.Bold = True
            ActiveSheet.Cells(2, 1) = "There are no Maps on this device."
            Sheets(FileName & " Analysis").Cells(21, 2) = "See Appendix E"
        End If
        Do Until x > Sheets(FileName & " Maps").UsedRange.Rows.Count
            Application.DisplayAlerts = False
            With Sheets(FileName & " Maps").Range("A" & x & ":H" & x)
                .MergeCells = True
                .WrapText = True
            End With
            x = x + 1
        Loop
'VLANs Initial
'        If FileName = "Brocade_6610_Switchs" Then Stop
        Set rng = Sheets(FileName).Range("A:A").find(What:="vlan*name ")
        If Not rng Is Nothing Then
            y = rng.row
            strVLAN = Sheets(FileName).Cells(y, 1)
            blVLAN = True
            Sheets.Add , ActiveSheet
            ActiveSheet.Name = FileName & " VLANs"
            ActiveSheet.Tab.Color = tabCol
            With ActiveSheet.Cells(1, 1)
                .Value = "VLANs"
                .Font.Bold = True
            End With
            Sheets(FileName & " Analysis").Cells(26, 2) = "See Appendix G"
            ActiveSheet.Cells(2, 1) = Sheets(FileName).Cells(y, 1)
            used = Sheets(FileName).UsedRange.Rows.Count
            y = y + 1
            If y > 0 Then
                Do Until rng Is Nothing
                    Set rng = Sheets(FileName).Range("A" & y & ":A" & used).find(What:="vlan*name ")
                    If Not rng Is Nothing Then y = rng.row
                        If Sheets(FileName).Cells(y, 1) <> strVLAN Then
                            If y <> 0 Then
                            ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1) = Sheets(FileName).Cells(y, 1)
                            strVLAN = Sheets(FileName).Cells(y, 1)
                        End If
                    Else
                        y = y + 1
                    End If
                Loop
                y = 0
            End If
        Else
            Sheets.Add , ActiveSheet
            ActiveSheet.Name = FileName & " VLANs"
            ActiveSheet.Tab.Color = tabCol
            With ActiveSheet.Cells(1, 1)
                .Value = "VLANs"
                .Font.Bold = True
            End With
            Sheets(FileName & " Analysis").Cells(26, 2) = "See Appendix G"
            ActiveSheet.Cells(2, 1) = "No VLANs associated with this device."
        End If
'Firewall Permit Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="permit")
        If Not rng Is Nothing Then
            y = rng.row
            Do Until y > Sheets(FileName).UsedRange.Rows.Count
                If InStr(1, Sheets(FileName).Cells(y, 1), "permit seq") > 0 Then
                    Sheets(FileName & " Analysis").Cells(P, 3) = Sheets(FileName).Cells(y, 1)
                    P = P + 1
                End If
                y = y + 1
            Loop
        Else
'            GoTo NextFile
        End If
        y = 0
        P = 4
        d = 4
'Firewall Deny Initial
        Set rng = Sheets(FileName).Range("A:A").find(What:="deny")
        If Not rng Is Nothing Then
            y = rng.row
            Do Until y > Sheets(FileName).UsedRange.Rows.Count
                If InStr(1, Sheets(FileName).Cells(y, 1), "deny   seq") > 0 Then
                    Sheets(FileName & " Analysis").Cells(d, 4) = Sheets(FileName).Cells(y, 1)
                    d = d + 1
                End If
                y = y + 1
            Loop
        End If
End Sub

Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As Worksheet

    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
     WorksheetExists = Not sht Is Nothing
End Function



Public Sub ColorWord(check As Range, shtName As String, row As Long, find As String)
Dim StartChar As Integer, _
    LenColor As Integer

Sheets(shtName).Activate
check.Select

For i = 1 To 5
    With Selection
        StartChar = InStr(1, check.Value, find)
        If StartChar = 0 Then Exit Sub
        .Characters(Start:=StartChar, Length:=Len(find)).Font.Color = RGB(255, 0, 0)
        StartChar = InStr(StartChar + 1, check.Value, find)
        If StartChar = 0 Then Exit Sub
            .Characters(Start:=StartChar, Length:=Len(find)).Font.Color = RGB(255, 0, 0)
        StartChar = InStr(StartChar + 1, check.Value, find)
        If StartChar = 0 Then Exit Sub
            .Characters(Start:=StartChar, Length:=Len(find)).Font.Color = RGB(255, 0, 0)
        StartChar = InStr(StartChar + 1, check.Value, find)
        If StartChar = 0 Then Exit Sub
            .Characters(Start:=StartChar, Length:=Len(find)).Font.Color = RGB(255, 0, 0)
        StartChar = InStr(StartChar + 1, check.Value, find)
        If StartChar = 0 Then Exit Sub
            .Characters(Start:=StartChar, Length:=Len(find)).Font.Color = RGB(255, 0, 0)
        StartChar = InStr(StartChar + 1, check.Value, find)
        If StartChar = 0 Then Exit Sub
            .Characters(Start:=StartChar, Length:=Len(find)).Font.Color = RGB(255, 0, 0)
        StartChar = InStr(StartChar + 1, check.Value, find)
        If StartChar = 0 Then Exit Sub
            .Characters(Start:=StartChar, Length:=Len(find)).Font.Color = RGB(255, 0, 0)
        StartChar = InStr(StartChar + 1, check.Value, find)
        If StartChar = 0 Then Exit Sub
            .Characters(Start:=StartChar, Length:=Len(find)).Font.Color = RGB(255, 0, 0)
        StartChar = InStr(StartChar + 1, check.Value, find)
        If StartChar = 0 Then Exit Sub
            .Characters(Start:=StartChar, Length:=Len(find)).Font.Color = RGB(255, 0, 0)
        StartChar = InStr(StartChar + 1, check.Value, find)
        If StartChar = 0 Then Exit Sub
            .Characters(Start:=StartChar, Length:=Len(find)).Font.Color = RGB(255, 0, 0)
    End With
Next i

End Sub


Public Sub Forti()
    Dim strHN, strModel, strConfig, strLog, strTelnet, strFN, strForti As String
    Dim rng As Range
        Set rng = Nothing
    Dim wb As Workbook
        Set wb = ActiveWorkbook
    Dim q As Long
        
    
    strFN = ActiveSheet.Name
    strForti = Left(strFN, 22)
    If strForti = "STARTER TAB" Then Exit Sub
    ActiveSheet.Copy After:=wbMain.Sheets(Sheets.Count)

    If Len(strForti & " Worksheet") <= 25 Then
        strWS = " Worksheet"
    ElseIf Len(strForti & " Worksht") <= 25 Then
        strWS = " Worksht"
    Else
        strWS = " WS"
    End If
    
    If WorksheetExists(strForti & strWS, wbMain) = False Then
        wbMain.Sheets.Add
        ActiveSheet.Tab.Color = tabCol
        ActiveSheet.Name = strForti & strWS
    Else
        wbMain.Sheets.Add
        ActiveSheet.Tab.Color = tabCol
        ActiveSheet.Name = strForti & strWS & " (2)"
    End If
    wbMain.Activate

'Labels
    Sheets(strForti & strWS).Cells(4, 1) = "Control"
    Sheets(strForti & strWS).Cells(4, 2) = "Pass / Fail"
    Sheets(strForti & strWS).Cells(4, 3) = "Config Data"
    Sheets(strForti & strWS).Range("A4:C4").Font.Bold = True
    Sheets(strForti & strWS).Cells(5, 1) = "Hostname"
    Sheets(strForti & strWS).Cells(6, 1) = "Model"
    Sheets(strForti & strWS).Cells(7, 1) = "Config Version"
    Sheets(strForti & strWS).Cells(8, 1) = "Clock Setting"
    Sheets(strForti & strWS).Cells(9, 1) = "Logging"
    Sheets(strForti & strWS).Cells(10, 1) = "Access Lists"
    Sheets(strForti & strWS).Cells(11, 1) = "Telnet"
    Sheets(strForti & strWS).Cells(12, 1) = "USB Auto Install"
    Sheets(strForti & strWS).Cells(13, 1) = "VLANs"
    
'Column Widths and row freeze
    Sheets(strForti & strWS).Activate
    Sheets(strForti & strWS).Columns(1).ColumnWidth = 23
    Sheets(strForti & strWS).Columns(2).ColumnWidth = 23
    Sheets(strForti & strWS).Columns(3).ColumnWidth = 40
    Sheets(strForti & strWS).Rows(5).Select
'    ActiveWindow.FreezePanes = True
    Sheets(strForti & strWS).Range("A4:B50").HorizontalAlignment = xlCenter

'Hostname
    Set rng = Sheets(strFN).Range("A:A").find(What:="Set hostname")
    If Not rng Is Nothing Then
        y = rng.row
        strHN = Mid(Sheets(strFN).Cells(y, 1), 19, 50)
        'If Right(strHN, 1) = Chr(44) Then strHN = Left(strHN, Len(strHN) - 1)
        strHN = Left(strHN, Len(strHN) - 1)
        Sheets(strForti & strWS).Cells(5, 3) = strHN
    End If
    With Sheets(strForti & strWS).Cells(5, 2)
        .Font.Bold = True
        .Interior.Color = 5287936
        .Font.Color = 16777215
        .Value = "Pass"
    End With
'Model
    Set rng = Sheets(strFN).Range("A:A").find(What:="Set alias")
    If Not rng Is Nothing Then
        y = rng.row
        strModel = Mid(Sheets(strFN).Cells(y, 1), 16, 50)
        'If Right(strModel, 1) = Chr(44) Then strModel = Left(strModel, Len(strModel) - 1)
        strModel = Left(strModel, Len(strModel) - 1)
        Sheets(strForti & strWS).Cells(6, 3) = strModel
    End If
    With Sheets(strForti & strWS).Cells(6, 2)
        .Font.Bold = True
        .Interior.Color = 5287936
        .Font.Color = 16777215
        .Value = "Pass"
    End With
'Config Version
    Set rng = Sheets(strFN).Range("A:A").find(What:="#config-version")
    If Not rng Is Nothing Then
        y = rng.row
        strConfig = Mid(Sheets(strFN).Cells(y, 1), 24, 5)
        Sheets(strForti & strWS).Cells(7, 3) = strConfig
    End If
    For b = 1 To UBound(varPass)
        If InStr(1, Sheets(strForti & strWS).Cells(7, 3), varPass(b)) > 0 Then
            With Sheets(strForti & strWS).Cells(7, 2)
                .Font.Bold = True
                .Interior.Color = 5287936
                .Font.Color = 16777215
                .Value = "Pass"
            End With
        End If
    Next b
    If Sheets(strForti & strWS).Cells(7, 2) <> "Pass" Then
        For b = 1 To UBound(varFail)
            If InStr(1, Sheets(strForti & strWS).Cells(7, 3), varFail(b)) > 0 Then
                With Sheets(strForti & strWS).Cells(7, 2)
                    .Font.Color = 16777215
                    .Interior.Color = 192
                    .Value = "Fail"
                End With
                If varFailDate(b) <> "" Then
                    Sheets(strForti & strWS).Cells(7, 3) = Sheets(strForti & strWS).Cells(7, 3) & Chr(10) & "Last Day of Support: " & varFailDate(b)
                End If
            End If
        Next b
    End If
'Clock Setting
    Set rng = Sheets(strFN).Range("A:A").find(What:="set ntpsync enable")
    If Not rng Is Nothing Then
        y = rng.row
        Sheets(strForti & strWS).Cells(8, 3) = "NTP Enabled"
        With Sheets(strForti & strWS).Cells(8, 2)
            .Font.Bold = True
            .Interior.Color = 5287936
            .Font.Color = 16777215
            .Value = "Pass"
        End With
    Else
        With Sheets(strForti & strWS).Cells(8, 2)
            .Font.Color = 16777215
            .Interior.Color = 192
            .Value = "Fail"
        End With
    End If
'Logging
    Set rng = Sheets(strFN).Range("A:A").find(What:="config log")
    If Not rng Is Nothing Then
        y = rng.row
        Do Until Sheets(strFN).Cells(y, 1) = "end"
            strLog = strLog & Chr(10) & Sheets(strFN).Cells(y, 1)
            y = y + 1
        Loop
        Sheets(strForti & strWS).Cells(9, 3) = strLog
        If RegExx(Sheets(strForti & strWS).Cells(9, 3)) = True Then
            With Sheets(strForti & strWS).Cells(9, 2)
                .Font.Bold = True
                .Interior.Color = 5287936
                .Font.Color = 16777215
                .Value = "Pass"
            End With
        Else
            With Sheets(strForti & strWS).Cells(9, 2)
                .Font.Color = 16777215
                .Interior.Color = 192
                .Value = "Fail"
            End With
            Sheets(strForti & strWS).Cells(9, 3) = Sheets(strForti & strWS).Cells(9, 3) & Chr(10) & "Not logging to an external server."
            Call ColorWord(Sheets(strForti & strWS).Cells(9, 3), strForti & strWS, 9, "Not logging to an external server.")
        End If
    Else
        Sheets(strForti & strWS).Cells(9, 3) = "N/A"
        With Sheets(strForti & strWS).Cells(9, 2)
            .Font.Color = 16777215
            .Interior.Color = 192
            .Value = "Fail"
        End With
    End If
'Access Lists
'    If InStr(1, strFN, "Genban") > 0 Then Stop
    Sheets(strForti & strWS).Activate
    Dim strFWP() As String
    Dim strFWP2 As String
    Dim varLine As Variant
    Set rng = Sheets(strFN).Range("A:A").find(What:="config firewall policy")
    If Not rng Is Nothing Then
        y = rng.row
        strFWP2 = Sheets(strFN).Cells(y, 1)
        y = y + 1
        Do Until InStr(1, Sheets(strFN).Cells(y, 1), "config") > 0
            strFWP2 = strFWP2 & Chr(10) & Sheets(strFN).Cells(y, 1) & Chr(10)
            y = y + 1
        Loop
        Sheets(strForti & strWS).Cells(10, 3) = strFWP2
        With Sheets(strForti & strWS).Cells(10, 2)
            .Font.Bold = True
            .Interior.Color = 5287936
            .Font.Color = 16777215
            .Value = "Pass"
        End With
        If InStr(1, Sheets(strForti & strWS).Cells(10, 3), "set srcaddr " & Chr(44) & "all" & Chr(44)) > 0 Then
            With Sheets(strForti & strWS).Cells(10, 2)
                .Font.Color = 0
                .Interior.Color = 65535
                .Value = "Check"
            End With
        ElseIf InStr(1, Sheets(strForti & strWS).Cells(10, 3), "set dstaddr " & Chr(44) & "all" & Chr(44)) > 0 Then
            With Sheets(strForti & strWS).Cells(10, 2)
                .Font.Color = 0
                .Interior.Color = 65535
                .Value = "Check"
            End With
        ElseIf InStr(1, Sheets(strForti & strWS).Cells(10, 3), "set service " & Chr(44) & "all" & Chr(44)) > 0 Then
            With Sheets(strForti & strWS).Cells(10, 2)
                .Font.Color = 0
                .Interior.Color = 65535
                .Value = "Check"
            End With
        End If
    End If
'Access Lists Appendix
    ThisWorkbook.Activate
    Sheets(strForti & strWS).Activate
    x = 4
    Do Until ActiveSheet.Cells(x, 1) = ""
        x = x + 1
    Loop
    Sheets(strForti & strWS).Cells(x + 3, 1).Select
    x = Selection.row
    With Selection
        .Value = "Appendix A - Access Lists"
        .Font.Color = 9527094
        .Font.Bold = True
        .Font.Size = 16
    End With
    x = x + 1
    Dim c As Integer
        c = 4
    
    Sheets(strForti & strWS).Cells(10, 3).Select
    Selection.TextToColumns Destination:=Range("D10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="" & Chr(10) & "", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
        , 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
        Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array( _
        25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), _
        Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array( _
        38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), _
        Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array( _
        51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), _
        Array(58, 1), Array(59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array( _
        64, 1), Array(65, 1), Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), _
        Array(71, 1), Array(72, 1), Array(73, 1)), TrailingMinusNumbers:=True
    
    Do Until c > Sheets(strForti & strWS).UsedRange.Columns.Count
        If Sheets(strForti & strWS).Cells(10, c) <> "" Then
            Sheets(strForti & strWS).Cells(x, 1) = Trim(Sheets(strForti & strWS).Cells(10, c))
            c = c + 1
            x = x + 1
        Else
            c = c + 1
        End If
    Loop
    Sheets(strForti & strWS).Range("A17:A" & x).HorizontalAlignment = xlRight
    Sheets(strForti & strWS).Range("A17:A" & x).HorizontalAlignment = xlLeft
    Sheets(strForti & strWS).Range("D:CD").EntireColumn.Delete
'    Sheets(strForti & strWS).Cells(Selection.row, 1).Select
'    Dim s As Variant
'    strFWP() = Split(Sheets(strForti & strWS).Cells(10, 3), vbNewLine)
'    For Each varLine In strFWP()
'        Sheets(strForti & strWS).Cells(Selection.row, 1) = varLine
'        Selection.row = Selection.row + 1
'    Next varLine
        
        
    
'    Sheets(strForti & strWS).Paste
    Sheets(strForti & strWS).Cells(10, 3) = "See Appendix A"
    
    
        
'Telnet
    Set rng = Sheets(strFN).Range("A:A").find(What:="TELNET")
    If Not rng Is Nothing Then
        y = rng.row
        Sheets(strForti & strWS).Cells(11, 3) = "Telnet Enabled"
        With Sheets(strForti & strWS).Cells(11, 2)
            .Font.Color = 16777215
            .Interior.Color = 192
            .Value = "Fail"
        End With
        Call ColorWord(Sheets(strForti & strWS).Cells(11, 3), strForti & strWS, 11, "Telnet Enabled")
    Else
        Sheets(strForti & strWS).Cells(11, 3) = "No Telnet"
        With Sheets(strForti & strWS).Cells(10, 2)
            .Font.Bold = True
            .Interior.Color = 5287936
            .Font.Color = 16777215
            .Value = "Pass"
        End With
    End If
'USB Auto Install
    Set rng = Sheets(strFN).Range("A:A").find(What:="set auto-install-config disable")
    If Not rng Is Nothing Then
        y = rng.row
        Sheets(strForti & strWS).Cells(12, 3) = Sheets(strForti).Cells(y, 1)
        With Sheets(strForti & strWS).Cells(12, 2)
            .Font.Bold = True
            .Interior.Color = 5287936
            .Font.Color = 16777215
            .Value = "Pass"
        End With
    Else
        Sheets(strForti & strWS).Cells(12, 3) = "USB Auto Runs"
        With Sheets(strForti & strWS).Cells(12, 2)
            .Font.Color = 16777215
            .Interior.Color = 192
            .Value = "Fail"
        End With
        Call ColorWord(Sheets(strForti & strWS).Cells(12, 3), strForti & strWS, 11, "USB Auto Runs")
    End If
'VLANs
    Set rng = Sheets(strFN).Range("A:A").find(What:="set vlanid")
    If Not rng Is Nothing Then
        y = rng.row
        strVLAN = Trim(Sheets(strFN).Cells(y, 1))
        Do Until rng Is Nothing
            Set rng = Sheets(strFN).Range("A" & y + 2 & ":A100000").find(What:="vlanid")
            If Not rng Is Nothing Then
                y = rng.row
                strVLAN = strVLAN & Chr(10) & Trim(Sheets(strFN).Cells(y, 1))
            End If
        Loop
        If strVLAN <> "" Then
            Sheets(strForti & strWS).Cells(13, 3) = strVLAN
            With Sheets(strForti & strWS).Cells(13, 2)
                .Font.Bold = True
                .Interior.Color = 5287936
                .Font.Color = 16777215
                .Value = "Pass"
            End With
        End If
    Else
        Sheets(strForti & strWS).Cells(13, 3) = "No VLANs"
        With Sheets(strForti & strWS).Cells(13, 2)
            .Value = "N/A"
            .Interior.Color = 14277081
        End With
    End If
    wb.Close False
    
    Sheets("STARTER TAB").Activate
    Sheets(strForti & strWS).Activate
    With Sheets(strForti & strWS).Cells(1, 1)
        .Font.Color = 6299648
        .Font.Bold = True
        .Font.Size = 16
        .Value = strFN & " Analysis"
    End With
    
    Set rng = Sheets(strForti & strWS).Range("A:A").find(What:="VLANs")
    If Not rng Is Nothing Then
        y = rng.row + 1
'        ActiveSheet.Rows(y & ":" & y + 100).EntireRow.Delete
        ActiveWorkbook.Save
    End If
    With Sheets(strForti & strWS).Range("A4:C" & Sheets(strForti & strWS).UsedRange.Rows.Count).Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    Sheets(strForti & strWS).Rows(2).Select
    ActiveWindow.FreezePanes = True
        
End Sub


Public Function OpenWkBks(strWkBk As String)
    Dim wb As Workbook
    
    For Each wb In Workbooks
        If wb.Name = strWkBk Then
            OpenWkBks = True
            Exit Function
        Else
            OpenWkBks = False
        End If
    Next wb
End Function

 

[Dad_x6]

In response to your suggestion on the line of code merging two cells, this is what I have...

Application.DisplayAlerts = False
ActiveSheet.Range("A1:B1").Merge

I do not have a DisplayAlerts = True after that, because I don't want it displaying alerts for the rest of the code.

 

[Dad_x6]

I LOVE IT!!! I commented out every line that MergeCells in it, and I still got the warning messages at the end about merging cells. Sigh...

 

[Dad_x6]

I stand corrected. There was one more instance in another module that was called from the main module. I commented that out, and problem solved.

 

[6StringJazzer]

Well, it may suppress the error but then you don't get your cells merged. I will look at your code when I can.

 

[Dad_x6]

No worries. I ended up just autofitting the columns and therefore didn't need to merge cells.