Sub TextBox1_Click()
    Dim ws As Worksheet, Found As Range
    Dim myText As String, FirstAddress As String
    Dim AddressStr As String, foundNum As Integer
    Dim LastRow As Long
    myText = Worksheets("instructions").Range("G6")
    If myText = "" Then Exit Sub
    re = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address
    Worksheets("instructions").Range("A16:BB100").Delete
    Worksheets("check sheet").Range("A1:A1000").Delete
    For Each ws In ThisWorkbook.Worksheets
        With ws
            If ws.Name = "Instructions" Or ws.Name = "Storage Locations" Then GoTo myNext
            t = ws.Name
            Set Found = .Range("B3:AD10000").Find(What:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
            If Not Found Is Nothing Then
                If Not foundNum > 1 Then
                    Worksheets("instructions").Range("A17").Value = "Sheet & Location"
                    Worksheets("instructions").Range("A" & 17 + foundNum).Font.Bold = True
                    tbl_start = Worksheets("instructions").Range("A" & 17 + foundNum).Address
                    r1 = Found.Row
                    trng = Range(tbl_start, "A" & 17 + foundNum).Address
                    Worksheets(ws.Name).Range("B2:AA2").Copy
                    Worksheets("instructions").Range("B17").Select
                    Worksheets("check sheet").Range("A1" & foundNum).Value = r1
                Else
                    foundNum = foundNum + 1
                    Worksheets("instructions").Range("A" & 17 + foundNum).Value = "Sheet & Location"
                    Worksheets("instructions").Range("A" & 17 + foundNum).Font.Bold = True
                    tbl_start = Worksheets("instructions").Range("A" & 17 + foundNum).Address
                    r1 = Found.Row
                    trng = Range(tbl_start, "A" & 17 + foundNum).Address
                    Worksheets(ws.Name).Range("B2:AA2").Copy
                    Worksheets("instructions").Range("B" & 17 + foundNum).Select
                    Worksheets("check sheet").Range("A1" & foundNum).Value = r1
                End If
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Selection.Font.Bold = True
                FirstAddress = Found.Address
                Do
                    foundNum = foundNum + 1
                    AddressStr = .Name & " " & Found.Address & vbCrLf
                    addr = Found.Address
                    Set Found = .Range("B3:AD10000").FindNext(Found)
                    r1 = Found.Row
                    If WorksheetFunction.CountIf(Worksheets("check sheet").Range("A1:A1000"), r1) < 2 Then
                    Else
                        GoTo next_worksheet
                    End If
                    Worksheets("check sheet").Range("A1" & foundNum).Value = r1
                    row18 = foundNum + 17
                    Found.EntireRow.Copy Destination:=Worksheets("instructions").Range("A" & row18)
                    Worksheets("instructions").Range("AA1") = AddressStr
                    Range("AA1").Copy
                    Range("A" & row18).Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    tt = ws.Name
                    ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("instructions").Range("A" & row18), Address:="", SubAddress:=ws.Name + "!" + addr, TextToDisplay:=AddressStr
                    Range("A" & row18 & ":AD" & row18).Select
                    Range("A" & row18 & ":AD" & row18).Borders(xlEdgeLeft).LineStyle = xlContinuous
                    Range("A" & row18 & ":AD" & row18).Borders(xlEdgeLeft).Weight = xlThin
                    Range("A" & row18 & ":AD" & row18).Borders(xlEdgeTop).LineStyle = xlContinuous
                    Range("A" & row18 & ":AD" & row18).Borders(xlEdgeTop).Weight = xlThin
                    Range("A" & row18 & ":AD" & row18).Borders(xlEdgeBottom).LineStyle = xlContinuous
                    Range("A" & row18 & ":AD" & row18).Borders(xlEdgeBottom).Weight = xlThin
                    Range("A" & row18 & ":AD" & row18).Borders(xlEdgeRight).LineStyle = xlContinuous
                    Range("A" & row18 & ":AD" & row18).Borders(xlEdgeRight).Weight = xlThin
                    Range("A" & row18 & ":AD" & row18).Borders(xlInsideVertical).LineStyle = xlContinuous
                    Range("A" & row18 & ":AD" & row18).Borders(xlInsideVertical).Weight = xlThin
                    Range("A" & row18 & ":AD" & row18).Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    Range("A" & row18 & ":AD" & row18).Borders(xlInsideHorizontal).Weight = xlThin
                Loop While Not Found Is Nothing And Found.Address <> FirstAddress
            End If
            If Not Found Is Nothing Then
                foundNum = foundNum + 1
                ActiveSheet.ListObjects.Add(xlSrcRange, Range(tbl_start & ":$AA$" & row18), , xlYes).Name = "Table" & foundNum
                Range("A" & row18 & ":AD" & row18).Select
                Range("A" & row18 & ":AD" & row18).Borders(xlEdgeLeft).LineStyle = xlContinuous
                Range("A" & row18 & ":AD" & row18).Borders(xlEdgeLeft).Weight = xlThin
                Range("A" & row18 & ":AD" & row18).Borders(xlEdgeTop).LineStyle = xlContinuous
                Range("A" & row18 & ":AD" & row18).Borders(xlEdgeTop).Weight = xlThin
                Range("A" & row18 & ":AD" & row18).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Range("A" & row18 & ":AD" & row18).Borders(xlEdgeBottom).Weight = xlThin
                Range("A" & row18 & ":AD" & row18).Borders(xlEdgeRight).LineStyle = xlContinuous
                Range("A" & row18 & ":AD" & row18).Borders(xlEdgeRight).Weight = xlThin
                Range("A" & row18 & ":AD" & row18).Borders(xlInsideVertical).LineStyle = xlContinuous
                Range("A" & row18 & ":AD" & row18).Borders(xlInsideVertical).Weight = xlThin
                Range("A" & row18 & ":AD" & row18).Borders(xlInsideHorizontal).LineStyle = xlContinuous
                Range("A" & row18 & ":AD" & row18).Borders(xlInsideHorizontal).Weight = xlThin
            End If
myNext:
        End With
next_worksheet:
    Next ws
    If Len(AddressStr) Then
    Else:
        MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
    End If
    Dim lLastRow As Long, lLastColumn As Long
    Dim lRealLastRow As Long, lRealLastColumn As Long
    With Range("A1").SpecialCells(xlCellTypeLastCell)
        lLastRow = .Row
        lLastColumn = .Column
    End With
    lRealLastRow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
    lRealLastColumn = Cells.Find("*", Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
    If lRealLastRow < lLastRow Then
        Range(Cells(lRealLastRow + 1, 1), Cells(lLastRow, 1)).EntireRow.Delete
    End If
    If lRealLastColumn < lLastColumn Then
        Range(Cells(1, lRealLastColumn + 1), Cells(1, lLastColumn)).EntireColumn.Delete
    End If
    ActiveSheet.UsedRange    'Resets LastCell
    Worksheets("instructions").Range("G6").Select
End Sub