Sub Macro6()
    Dim ws As Worksheet
    Dim lLastRow As Long, lLastColumn As Long
    Dim lRealLastRow As Long, lRealLastColumn As Long
    'first get sheet data and put it into the check sheet
    Worksheets("check_sheet").Range("A17:Z1000").Delete
    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
    Number_of_parts = 10    'InputBox("Enter the number of units required")
    Part_Col = "E"    'InputBox("Enter the Column of the Part Number to check")
    qty_col = "CP"    'InputBox("Enter the Column to check for the required Quantity")
    Start_Row = 3    'InputBox("Enter the number of the First Row to check")
    ttttt = 0
    
    Sheets("Check_Sheet").Select
    str_rng = Part_Col & Start_Row
    Last_Row = ActiveSheet.Range("c3").SpecialCells(xlCellTypeLastCell).Row
    For i = 1 To Last_Row
        If Not IsEmpty(foundNum) Then
            find_it = Range(Part_Col & Start_Row + foundNum)    ' first cell to check
        Else
            find_it = Range(Part_Col & Start_Row).Value    ' first cell to check
        End If
        
        
        For Each ws In ThisWorkbook.Worksheets
            With ws
                If ws.Name = "Manufacturers & Suppliers" Or ws.Name = "Check_Sheet" _
                   Or ws.Name = "Instructions" Or ws.Name = "Storage Locations" _
                   Or ws.Name = "Check Sheet" Or ws.Name = "Output_Required" _
                   Or ws.Name = "Output_Have" Then
                    GoTo Next_ws
                End If
                t = ws.Name
                Set Found = .Range("F3:F10000").Find(What:=find_it, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
                If Not Found Is Nothing Then
                    X = Found.Address
                    y = Found.Row
                    yy = "$" & qty_col & "$" & y
                    ttt = Worksheets("Check_sheet").Range(yy).Value
                    aaa = Worksheets(t).Range("$D$" & y).Value
                    If ttt * Number_of_parts < aaa Then
                        'have_enough, copy to output_have, goto next part
                        FirstAddress = Found.Address
                        If ttttt <> 1 Then foundNum = foundNum + 1
                        AddressStr = .Name & " " & Found.Address & vbCrLf
                        addr = Found.Address
                        Set Found = .Range("F3:F10000").FindNext(Found)
                        r1 = Found.Row
                        Worksheets("check sheet").Range("A1" & foundNum).Value = r1
                        row18 = foundNum + 17
                        Found.EntireRow.Copy Destination:=Worksheets("check_sheet").Range("A" & row18)
                        Worksheets("check_sheet").Range("AA1") = AddressStr
                        Range("AA1").Copy
                        Range("A" & row18).Select
                        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        Worksheets("check_sheet").Range("B" & row18) = ttt * Number_of_parts
                    Else
                        'not enough, check for more locations, if not then copy to output_required
                        '  FirstAddress = Found.Address
                        foundNum = foundNum + 1
                        ttttt = 1
                        Worksheets("check sheet").Range("A1:A1000").Delete
                        Worksheets("check sheet").Range("AA1").Delete
                        Worksheets("check_sheet").Range("b" & row18) = ttt * Number_of_parts
                    End If
                End If
            End With
Next_ws:
            Worksheets("check sheet").Range("A1:A1000").Delete
            Worksheets("check sheet").Range("AA1").Delete
        Next ws
        i = i + 1
    Next i
    Worksheets("check sheet").Range("A1:A1000").Delete
    Worksheets("check sheet").Range("AA1").Delete
    If Len(AddressStr) Then
    Else:
        MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
    End If
    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("check_sheet").Range("A18").Select
    Worksheets("check_sheet").Range("G5").Select
End Sub