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 the code with a filter quickly... (this code is triggered by the analyst with a toolbar icon already built)
Here's an uploaded small example of the file:
https://app.box.com/s/ug4fblqau6lq9a91w6k7
Code:
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 special code has been identified in COL H of "TO" tab, we need to:
1-- locate all rows THAT HAVE NOT BEEN COLORIZED GREEN and hold THAT CODE,
(or)
2-- HAS NOT BEEN COLORIZED AND IS BLANK WITH NO CODE,
then proceed w/ my pre-existing code to begin copying data over to BOM sheet...
(Currently, it is copying over a ton of rows we don't need)
I just need it to look for something more specific before it copies over...
*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"
"(blank cell that has not been colored green)
Therefore, if the "D" is found in any string within a cell in COL H then proceed with rest of code...
There should ALWAYS be a match, but if for some strange reason it could not find a match when looking for "J3"'s Part# on the TO sheet,
MsgBox "Nothing on Your TO Matches Your End Item Part #"
THANKS GREATLY FOR THE HELP!
Here's an uploaded small example of the file:
https://app.box.com/s/ug4fblqau6lq9a91w6k7
Code:
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
'======================================================
'======================================================
'<<<< NEW CODE SHOULD BE INSERTED HERE that will do the following:
'
'...1. VBA STARTS WITH COL J3 PART# of BOM Worksheet
'...2. GOES TO THE "TO" sheet to FIND A PART# MATCH
'...3. FOUND MATCH ON LAST ROW
' 4. LOOKED TO COL "H" to FIND OUT WHAT CODE to USE
'...5. THEN BEGAN SEARCHING COL "H" FOR ANY uncolorized ROWS WITH THAT CODE (or) uncolorized rows w/ BLANKS in COL "H"
'..............a.. IF ROW IS = to 'NO BACKGROUND HIGHLIGHTING ON "TO" sheet
'..............b.. THEN PROCEED WITH THE BELOW CODE THAT WILL COPY OVER DATA FROM: B, F, G, A of "TO" sheet
'...................as follows:
'B of "TO" sheet to P of "BOM Worksheet"
'F to O
'G to E
'A to R
'======================================================
'======================================================
'
'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 SubNeed 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 special code has been identified in COL H of "TO" tab, we need to:
1-- locate all rows THAT HAVE NOT BEEN COLORIZED GREEN and hold THAT CODE,
(or)
2-- HAS NOT BEEN COLORIZED AND IS BLANK WITH NO CODE,
then proceed w/ my pre-existing code to begin copying data over to BOM sheet...
(Currently, it is copying over a ton of rows we don't need)
I just need it to look for something more specific before it copies over...
*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"
"(blank cell that has not been colored green)
Therefore, if the "D" is found in any string within a cell in COL H then proceed with rest of code...
There should ALWAYS be a match, but if for some strange reason it could not find a match when looking for "J3"'s Part# on the TO sheet,
MsgBox "Nothing on Your TO Matches Your End Item Part #"
THANKS GREATLY FOR THE HELP!
