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)
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!
Code:
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
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!