SEARCH driven Input Box - Need to adjust code to include better Copy/Paste functionality

[ChrisOK]

I'm using this code to perform a lookup, match, copy/paste to another sheet within the same wrkbk. It has come to my attn that there are a couple scenarios where this won't be able to handle a couple of tricky scenarios - hence the need to adjust quickly... (add a filter) (this code is triggered by the analyst with a toolbar icon already built)

Sub Mod_13_TO2BOM()

'works great on test file - need to get the real file cleaned so it will
'appropriately allow MATCHING to take place between the 2 sheets w/ the PN#


' code that selects the full sheet
'
    Sheets("TO").Select
    Cells.Select

'Sub TrimALLMcRitchie()

'THIS IS CRITICAL CODE!!  IT WILL CLEAN DATA OR ENTIRE SHEET OF DATA THAT HAS BEEN BROUGHT IN FROM AN
'OUTSIDE MAIN FRAME SYSTEM. IT WILL CLEAN EVERYTHING THAT MIGHT PREVENT YOUR LOOK UP MATCHING CODE FROM
'APPROPRIATELY FINDING MATCHES.  To Use: Select data or sheet needing cleaned, then run. (or add the code
'to this code to select desired range)

   
   'David McRitchie 2000-07-03 mod 2002-08-16 2005-09-29 join.htm
   '-- http://www.mvps.org/dmcritchie/excel/join.htm#trimall
   ' - Optionally reenable improperly terminated Change Event macros
   
      Application.DisplayAlerts = True
      Application.EnableEvents = True   'should be part of Change Event macro
   If Application.Calculation = xlCalculationManual Then
      MsgBox "Calculation was OFF will be turned ON upon completion"
   End If
   
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim cell As Range

   'Also Treat CHR 0160, as a space (CHR 032)
   Selection.Replace What:=Chr(160), replacement:=Chr(32), _
     lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(13) & Chr(10), replacement:=Chr(32), _
        lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(13), replacement:=Chr(32), _
        lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(21), replacement:=Chr(32), _
        lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   '---------------------------
   Selection.Replace What:=Chr(8), replacement:=Chr(32), _
      lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(9), replacement:=Chr(32), _
      lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   
'Trim in Excel removes extra internal spaces, VBA does not
   On Error Resume Next
   For Each cell In Intersect(Selection, _
      Selection.SpecialCells(xlConstants, xlTextValues))
     cell.Value = Application.Trim(cell.Value)
   Next cell
   On Error GoTo 0
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True

'=============================================================
'Sub CompareAndHighlight()

'THIS LOOKS FOR CELLS THAT >>> DO <<< MATCH AND HIGHLIGHTS THEM ON THE "TO" for the analyst
'....shows green highlighted rows on the TO so the analyst knows these WERE FOUND on the BOM and accounted for
'....leaves the items not found with no colorization


    Sheets("TO").Select
    Range("A1").Select

    Dim rng1 As Range, rng2 As Range, k As Integer, j As Integer
    Dim isMatch As Boolean

    For k = 7 To Sheets("TO").Range("B" & Rows.Count).End(xlUp).Row 'START ON ROW 7
        isMatch = True
        Set rng1 = Sheets("TO").Range("B" & k)
        For j = 5 To Sheets("BOM Worksheet").Range("P" & Rows.Count).End(xlUp).Row 'START ON ROW 5
            Set rng2 = Sheets("BOM Worksheet").Range("P" & j)
            If StrComp(Trim(rng1.Text), Trim(rng2.Text), vbTextCompare) = 0 Then
                isMatch = False
                Exit For
            End If
            Set rng2 = Nothing
        Next j

'HIGHLIGHT A MATCHED ROW OF THE "TO" ONLY OUT TO THE END OF WHERE DATA EXISTS

        If Not isMatch Then
            With Sheets("TO")
            .Range(.Range("A" & rng1.Row), .Cells(rng1.Row, .Columns.Count).End(xlToLeft)).Interior.Color = RGB(173, 255, 47)
    End With
        End If
        Set rng1 = Nothing
    Next k
'End Sub

   
'======================================================
'COPY DATA FROM THE "TO" sheet to the base of "BOM Worksheet" (into cols P, O, E, and R)
'AUTO-FIT SOME COLUMNS AND FORCE A SPECIFIC SIZE OF COL O (since it is so big) 
     
    Sheets("TO").Select

Dim x As Range, pnrng As Range, nr As Long
Application.ScreenUpdating = False
With Sheets("TO")
  For Each x In .Range("B7", .Range("B" & Rows.Count).End(xlUp))
    Set pnrng = Sheets("BOM Worksheet").Columns(16).Find(x.Value, lookat:=xlWhole)
    
'IF NO MATCH BETWEEN "B" OF TO AND "P" OF BOM THEN COPY THE "B" PN FROM TO to the base of the BOM
'ALSO COPY THE NOUN "O", THE UPA/qty "E" to the base of the BOM

    If pnrng Is Nothing Then
      nr = Sheets("BOM Worksheet").Range("P" & Rows.Count).End(xlUp).Offset(1).Row
      With Sheets("BOM Worksheet").Range("P" & nr)
        .Value = x.Value
        .Font.FontStyle = "Bold"
        .Font.Color = 255
      End With
      
      With Sheets("BOM Worksheet").Range("O" & nr)
        .Value = x.Offset(, 4).Value
        .Font.FontStyle = "Bold"
        .Font.Color = 255
      End With
      
      With Sheets("BOM Worksheet").Range("E" & nr)
        .Value = x.Offset(, 5).Value
        .Font.FontStyle = "Bold"
        .Font.Color = 255
      End With
'======================================================      
' Macro2_FORMATcolumnB4PastingDataText Macro
' Prob w/ Fig Ref converting into dates and odd numbers like 41319. This is Format>Cells>Text prior to pasting data into it.
' THE BELOW CODE (HELPS) BUT DOES NOT CORRECT THE PROBLEM
' TRIED TO FORMAT THE COLUMN PRIOR TO PASTING INTO IT -- BUT STILL NOT PERFECT
' NEED TO FIGURE OUT HOW TO EXTRACT THE FIRST 5 CHARACTERS STARTING ON THE LEFT WHICH SHOULD HELP THE PROBLEM

'
    Range("R5:R2000").Select
    Selection.NumberFormat = "@"
      
        With Sheets("BOM Worksheet").Range("R" & nr)
        .Value = x.Offset(, -1).Value
        .Font.FontStyle = "Bold"
        .Font.Color = 255
      End With
      
    End If
  Next x
  
End With

'====================================================== 
' selects column and AUTO-FIT-adjusts the width

With Sheets("BOM Worksheet")
  .Columns("E:E").AutoFit
  .Columns("P:R").AutoFit
  .Activate
  
  ' Macro1_adjustColumnWIDTH Macro
' selects column and adjusts the width TO A SPECIFIC WIDTH
'
    Columns("O:O").Select
    Selection.ColumnWidth = 25
  
End With
Application.ScreenUpdating = True
'====================================================== 

'RETURNS USER TO CELL A1 RATHER THAN LEAVING A COLUMN HIGLIGHTED
    Range("A1").Select
End Sub

Need help adding the front-end filter to my existing code:

HERE'S THE FILTERING PIECE I NEED INCORPORATED TO HANDLE THE ODD SCENARIOS:
1-Start on "BOM Worksheet" tab
2-Look to target cell: "J3" for main Part #
3-Jump to "TO" tab, COL B to look for MATCH
4-If match found, look to adjacent COL H for a special code

Now that the code has been identified, we need to locate all rows that hold THAT CODE and copy data from those rows over to the "BOM Worksheet" tab.
(Currently, it is copying over a ton of rows we don't need) --- We need to filter it down to where only rows EQUAL TO THAT CODE get copied over to the "BOM Worksheet"

Specifically copy the following: (my code is already doing this piece)
Copy contents of COL B cell over to the BOM Worksheet into COL P (PN)
Copy contents of COL F cell over to the BOM Worksheet into COL O (NOUN)
Copy contents of COL G cell over to the BOM Worksheet into COL E (UPA/QTY)
Copy contents of COL A cell over to the BOM Worksheet into COL R (Fig Ref)

*Important Note regarding the COL H search for the code...(does NOT need to be an exact match)
If the code is a "D"
The cell data could look like this:
"D"
"ABCDEF"
"CDE"
Therefore, if the "D" is found in any string/format within a cell in COL H then copy over the full contents of that cell in Col H.

THANKS GREATLY FOR THE HELP!

 

[ChrisOK]

BTW, IGNORE the "Search Driven Input Box" title bar reference.... Initially, I was going to go that direction - but decided this lookup/match/filtering method would be much faster for the analyst.. (explained in the post itself) THANKS AGAIN FOR ANY HELP ANYONE CAN PROVIDE TO CORRECT THIS ISSUE....