OK, I elected to go with the Sub due primarily to the need to have that 2nd
workbook open and problems that can arise if it isn't and we're using a
Function.
This does take the 2 phrases for including dash numbers into account. You
still need to provide the specific sheet name in the workbooks that the lists
are on; there's places in the code to do that, so it should adapt to your
workbooks well. I'd test on copies of them first, just in case.
Sub GetAllPartNumbers()
'these Const values are for the sheet
'and column in THIS WORKBOOK where the
'"4047122(All Dash No.)" type entries reside
Const ckListSheetName = "Sheet1" ' change as needed
Const ckListColumnID = "A"
'change these 2 Const values to point to the sheet
'and column where the individual part numbers reside
Const plWkBookName = "TCTO_applicability_Mar18_2010_clean.xlsx"
Const plSheetName = "Sheet1" ' change as needed
Const plColumnID = "C"
'phrases to search for to determine if all dash numbers
'are to be included. ENTER IN ALL CAPS
Const phrase1 = "(ALL DASH NO.)"
Const phrase2 = "(ALL DASH NUMBERS)"
Dim rawText As String
Dim currentPartID As String
Dim foundParts As String
Dim IncludeDashes As Boolean
Dim partsWB As Workbook
Dim partsSheet As Worksheet
Dim partsList As Range
Dim anyPartEntry As Range
'
Dim ckListWS As Worksheet
Dim ckListRange As Range
Dim anyCkListEntry As Range
'test if the book with the part numbers is open and available
On Error Resume Next
Set partsWB = Workbooks(plWkBookName)
If Err <> 0 Then
Err.Clear
MsgBox "Required Workbook" & vbCrLf & _
plWkBookName & vbCrLf & _
" Is Not Open", vbOKOnly, "Cannot Continue..."
Exit Sub
End If
On Error GoTo 0
'this should set up things to get the part #s from
'the appropriate sheet in TCTO_applicability_Mar18_2010_clean.xlsx
'in column C beginning at row 2.
Set partsSheet = partsWB.Worksheets(plSheetName)
Set partsList = partsSheet.Range(plColumnID & "2:" & _
partsSheet.Range(plColumnID & Rows.Count).End(xlUp).Address)
'now set up reference to the worksheet/column in this workbook
Set ckListWS = ThisWorkbook.Worksheets(ckListSheetName)
Set ckListRange = ckListWS.Range(ckListColumnID & "2:" & _
ckListWS.Range(ckListColumnID & Rows.Count).End(xlUp).Address)
'work through this workbook's entries
For Each anyCkListEntry In ckListRange
If Not IsEmpty(anyCkListEntry) Then
rawText = UCase(anyCkListEntry.Value)
If Right(rawText, 1) <> "," Then
rawText = rawText & ","
End If
foundParts = ""
Do While Len(rawText) > 1
currentPartID = Left(rawText, _
InStr(rawText, ","))
'remove from raw data
rawText = Right(rawText, _
Len(rawText) - Len(currentPartID))
currentPartID = Left(currentPartID, _
Len(currentPartID) - 1)
IncludeDashes = False
'have to test separately rather than
'with an OR because of need to remove
'the specific indicator
If InStr(currentPartID, phrase1) > 0 Then
IncludeDashes = True
currentPartID = Trim(Left(currentPartID, _
InStr(currentPartID, phrase1) - 1))
End If
If InStr(currentPartID, phrase2) > 0 Then
IncludeDashes = True
currentPartID = Trim(Left(currentPartID, _
InStr(currentPartID, phrase2) - 1))
End If
currentPartID = Trim(currentPartID)
For Each anyPartEntry In partsList
If IncludeDashes Then
If InStr(anyPartEntry, currentPartID) > 0 Then
foundParts = foundParts & anyPartEntry & ","
End If
Else
If Trim(anyPartEntry) = currentPartID Then
foundParts = foundParts & Trim(Str(anyPartEntry)) & ","
End If
End If
Next
Loop
If Len(foundParts) > 0 Then
foundParts = Left(foundParts, _
Len(foundParts) - 1)
End If
'put the results on the sheet
'change offset 2nd parameter to "push" to
'other columns. 1 = 1 column to right of the
' "4047122(All Dash No.)" entries column
'the single quote forces numbers to appear as text
'and is needed when no dash numbers are included
anyCkListEntry.Offset(0, 1) = "'" & foundParts
End If ' end of test for empty cells
Next ' end of loop through this workbook's list
'housekeeping
Set partsList = Nothing
Set partsSheet = Nothing
Set partsWB = Nothing
Set ckListRange = Nothing
Set ckListWS = Nothing
'let the user know it's finished
MsgBox "Task Completed"
End Sub
Richard the Lion-Hearted said:
OK here it is.
The list of part numbers (1 in each row) are in column A in file
All_F100_PN.xlsm, while the ones with "(All Dash no.)" or "(all dash
numbers)" are in column C in file TCTO_applicaibility_Mar18_2010_clean.xlsm
I did not tell you that I need to look for numbers with either value after it.
"(All Dash no.)" or "(all dash numbers)" are used and both are acceptable
when looking for candidates for the search in part numbers.
Can the IF statements in your code be updated to show that?
I appreciate the work you have done on this.
JLatham said:
There's always a catch ... <g>
Ok, both workbooks will need to be open to get the job done. And I need to
know the name of the worksheet with the list of part numbers (the real ones)
on it. I think that's in the TCTO_applicability_Mar18_2010_clean.xlsx
workbook, if I understand things correctly.
Give me a little time and I'll modify the code to deal with the 2nd workbook
and post back with modified solution.
Richard the Lion-Hearted said:
Actually, the list of parts in the one column start at A2 in file
All_F100_PN.xlsx while the "Part Number" column starts in C2 in file
TCTO_applicability_Mar18_2010_clean.xlsx
:
How about a User Defined Function (UDF) solution?
This will do as you want, but of course will need to be tailored to your
workbook. Right now it assumes the sample rows data you show is in column K
on the same sheet. That probably will have to be changed.
But once you get that straight, then you can simply enter the function name
like any other worksheet function into a cell and get the results.
Assuming your 4047122(All Dash no.), 4057222(All Dash no.), 4058222(All Dash
no.), 4060122(All Dash no.) entry is in cell A1, then you'd use the function
like:
=GetAllPartNumbers(A1)
in a cell and the results will be shown.
To put the code into the workbook: open it, press [Alt]+[F11] to open the
VB Editor and then choose Insert --> Module and copy and paste the code below
into it. Make the edits required to identify the sheet and column the parts
numbers list is on/is in and give it a try.
Function GetAllPartNumbers(sourceCell As Range)
'change these 2 Const values to point to the sheet
'and column where the individual part numbers reside
Const plSheetName = "Sheet1"
Const plColumnID = "K"
Dim rawText As String
Dim currentPartID As String
Dim foundParts As String
Dim IncludeDashes As Boolean
Dim partsSheet As Worksheet
Dim partsList As Range
Dim anyPartEntry As Range
GetAllPartNumbers = ""
rawText = sourceCell.Value
If Right(rawText, 1) <> "," Then
rawText = rawText & ","
End If
Set partsSheet = ThisWorkbook.Worksheets(plSheetName)
Set partsList = partsSheet.Range(plColumnID & "1:" & _
partsSheet.Range(plColumnID & Rows.Count).End(xlUp).Address)
foundParts = ""
Do While Len(rawText) > 1
currentPartID = Left(rawText, _
InStr(rawText, ","))
'remove from raw data
rawText = Right(rawText, _
Len(rawText) - Len(currentPartID))
currentPartID = Left(currentPartID, _
Len(currentPartID) - 1)
IncludeDashes = False
If InStr(currentPartID, "(All Dash no.)") > 0 Then
IncludeDashes = True
currentPartID = Trim(Left(currentPartID, _
InStr(currentPartID, "(All Dash no.)") - 1))
End If
currentPartID = Trim(currentPartID)
For Each anyPartEntry In partsList
If IncludeDashes Then
If InStr(anyPartEntry, currentPartID) > 0 Then
foundParts = foundParts & anyPartEntry & ","
End If
Else
If Trim(anyPartEntry) = currentPartID Then
foundParts = foundParts & anyPartEntry & ","
End If
End If
Next
Loop
If Len(foundParts) > 0 Then
foundParts = Left(foundParts, _
Len(foundParts) - 1)
End If
GetAllPartNumbers = foundParts
Set partsList = Nothing
Set partsSheet = Nothing
End Function
:
I have a table called "220_reference" with a column name "Part Number" having
a sample value of below:
4047122(All Dash no.), 4057222(All Dash no.), 4058222(All Dash no.),
4060122(All Dash no.)
The entire value is in one cell representing the "Part Number"
column(defined as general type so text I suppose).
Simple enough. But what I need to do is take any number that has "(All Dash
no.)" after it and search through a column in another table to retrieve any
rows that have that number(text) in it. The other table name is "220" with
one column named pn1_part_no_oem.
A sample of rows (also defined as general type in excel) in the 2nd table is
as follows:
4047122-13
4058222
4058222-705
4057222
4057222-2
4058222-704
4057222-1
4057222-7
4058222-701
4047122
4047122-12
Once retrieved(found), I need to format the output with commas between.
OK, not done though. If each number in the 1st table has "(All Dash no.)"
after it, then I need to provide all numbers from each in the same new cell
with commas between all of them. So, if all 4 numbers above have 4 matches
each, the new cell will have 16 values with commas between. This means that
each number will need to be checked one-at-a-time for the value "(All Dash
no.)" after it, and then process the query for similar values in the 2nd
table's pn1_part_no_oem column.
Given the sample data above, then the new cell's contents would be:
4058222,4058222-701,4058222-704,4058222-705,4057222,4057222-2,4057222-1,4057222-7,4047122,4047122-12,4047122-13
Can anybody help me on this impossible mission?
