With some (a great deal of) help, I was able to write a VB script that did just about everything I wanted it to do. The new file with script can be found at the following address:
http://www.entertainerdj.com/Rob.xls
I do have one remaining problem that I wanted to solve. Because MANY of the parts on sheet 8 do not include the part numbers and the descriptions are written slightly different than on the first seven sheets, when I search for the description (or part of it) when the part number is not available, it does not find most of them because the two descriptions are noit written EXACTLY the same. To solve this, I would like to do the following:
Look at all the characters in the description instead of just the first 10. Then, Take those characters and create an array of all the individual charaters. Look for the description in sheet 8 that contains the most matching characters to the array created from the characters in the description being searched for. Then take that entry, compare the unit prices and see if there is a match. If the description on sheet 8 that comes closest to matching all the letters involved in the first 20 characters of the description being looked at in sheets 1 - 7 does NOT match the unit cost for said part, then I want the program to check the unit cost of the second closest match, then if still unsuccessful, the third closest match, etc. until it has reached the 5th closest match. If none of the 5 closest matches for the description also match the unit cost, then it will be assumed that the part I am looking for does not reside on sheet 8, and the process will go on to the next description writing nothing to the major and minor fields.
Hopefully, I am clear enough.
Let me know what you think.
I have pasted the code below. It has a couple of very minor variences from the one in the entire excel sheet at the address above, but nothing in the area I am talking about.
Public FindString As String, SearchRange As String, Value, FoundCell As Object
Public SearchRangeEnd As String, iCol As Integer, intSht As Integer, iRow As Integer
Public AllRows As Integer, FoundRows As Integer
'--------------------------
'Takes info in first seven Spread Sheets and finds "matching"
'Info in 8th sheet
'The idea is to match either by part numbers or descriptions in the first seven
'Sheets with Part Numbers or descriptions in the eighth sheet
'Then find minor and major headings describing where the parts are used
'And Inserting these minor/major headings into their respective rows in Sheets 1-7
'There are far fewer matches than had been hoped for.
'-------------------------------------------------------
Sub DoRob() 'Name of routine to do the above
AllRows = 0: FoundRows = 0 'Counters for how many we get
Application.ScreenUpdating = False 'Don't screw around waiting for the screen to refresh, it takes too much time
SearchRangeEnd = ":F810" 'Last Cell to look in on sheet 8
i = 2 'Counter for listing results in Data, the first row is the heading
'Data is a spread sheet that shows the matches and where they came from
For intSht = 1 To 7 'There are 7 worksheets with part Numbers we want to locate
Sheets(intSht).Activate
Sheets(intSht).Range("G2:N659").Select 'Clear preavious results
Selection.Clear
Range("A2").Select 'and move cursor back to begining
Set FoundCell = Worksheets(8).Columns("A").Find("GBM") ' Initialize the find object
SearchRange = "A2" & SearchRangeEnd 'Initial start point for each sheet
iRow = 3 'The First Row with partnumbers is 3 in all seven sheets
Do While Sheets(intSht).Cells(iRow, 1) > "" 'Part numbers are in column 1, keep chugging until part number is null
'Do part number search first
FindString = Sheets(intSht).Cells(iRow, 1) 'Column 1 is the part number column
FoundPart = 0 'Set the Switch for deciding to look by description
'This should be another sub, but it works okay
If Left(FindString, 1) <> "*" Then 'The * is a wildcard for find so don't even look if it's there
'The excel find routing sees ** as wild cards it'll look forever it
'the string we start with begins with an *
'Didn't plan on this happening, it should be a separate sub,
'But **** happens
'+++++++++++++++++++++Search by part number in Column 1
FindString = Sheets(intSht).Cells(iRow, 1).Value 'Search by part number in Column 1
l = Len(FindString) 'Get the length of the string
If l > 20 Then l = 20 'and check to see if it's longer than 20 characters
'Started with 15, but got a couple of illogical matches inasmuch
'as the compared as equal, but did not logically fit
FindString = Left(FindString, l) 'Get the first l characters, but 20 or less
Set FoundCell = Worksheets(8).Columns("A").Find("GBM") 'Keeps the method Find from being Nothing at the start
iCol = 6 'Columns where we put the info less one
Do Until (FoundCell Is Nothing) 'Find all the strings in sheet(8) that match
FindIt ' Go to this sub and see if we can locate FindString
If Not FoundCell Is Nothing Then 'Keep going until Nothing is returned
FoundPart = 1 'Set the switch saying we found a part number
'Stuff the findings in a sheet called Data. This will be helpful to see what's missing
Sheets("Data").Cells(i, 1) = FindString
Sheets("Data").Cells(i, 2) = iRow
Sheets("Data").Cells(i, 3) = Sheets(intSht).Name
Sheets("Data").Cells(i, 4) = "By Part Number"
Sheets("Data").Cells(i, 5) = FoundCell.Row
i = i + 1
MajorMinor 'Go do the major minor heading Thing now that we've found something
End If
Loop 'Keep looping until we find all occurences of partnumber
'End of search by part number
'+++++++++++++++++++++Search by part Descripiton in Column 1
If FoundPart = 0 Then 'Check to see if we need to do by Description
'Do Search by description as necessary
SearchRange = "A2" & SearchRangeEnd 'Initial start point for this sheet again
FindString = Sheets(intSht).Cells(iRow, 3).Value 'Search by description in Column 3
DollarVal = Sheets(intSht).Cells(iRow, 5) 'Get ready to compare dollar values
l = Len(FindString) 'Get the length of the string
If l > 10 Then l = 10 'and check to see if it's longer than 10 characters
FindString = Left(FindString, l) 'Get the first l characters, but 10 or less
Set FoundCell = Worksheets(8).Columns("A").Find("GBM") 'So it doesn't start with NOTHING
Do Until (FoundCell Is Nothing) 'Find all that are there
FindIt 'Go to this sub and see if we can locate FindString
If Not FoundCell Is Nothing Then 'Keep going until NOTHING is returnd
'Check to see if Amounts are equal
If DollarVal = Sheets(8).Cells(FoundCell.Row, 5).Value Then
Sheets("Data").Cells(i, 1) = FindString
Sheets("Data").Cells(i, 2) = iRow
Sheets("Data").Cells(i, 3) = Sheets(intSht).Name
Sheets("Data").Cells(i, 4) = "By Description"
Sheets("Data").Cells(i, 5) = FoundCell.Row
i = i + 1
MajorMinor
End If
End If
Loop ''Keep looping until we find all occurences of first 10 characters of description
End If 'End if for deciding to do process by description
End If ' End if for checking to see if Part number starts with *
iRow = iRow + 1
FoundPart = 0 'Set this so we're ready to start with partnumber again
Loop 'For end of sheet
'The following three lines fits all the data to all the columns
Sheets(intSht).Activate
Sheets(intSht).Columns("A:N").Select
Selection.Columns.AutoFit
Application.ScreenUpdating = True 'Display sheet that's done
Sheets(intSht).Range("G1:H1").Select
Application.ScreenUpdating = False 'Turn it off so it doesn't hassle us
iRow = iRow - 3
AllRows = AllRows + iRow
Next intSht 'For loop for all sheets
FoundRows = i - 1
Sheets(8).Activate 'Stop with Sheet1 displayed
Sheets(8).Range("G1:H1").Activate
Sheets(8).Range("G6").Value = "You have found " & FoundRows & " out of " & AllRows & " Rows"
End Sub 'Stop for this sub
'-----------------------------
'This thing finds a string taken from sheets 1-7 and looks in sheet 8
'FindString is the string delivered to the sub
Sub FindIt()
Sheets(8).Activate
Set FoundCell = Sheets(8).Range(SearchRange).Find(FindString)
If Not FoundCell Is Nothing Then 'Get out when it finally fails
Sheets(8).Range(Cells(FoundCell.Row + 1, FoundCell.Column), Cells(FoundCell.Row + 1, FoundCell.Column)).Select
SearchRange = Selection.Address & SearchRangeEnd 'Keep changing the search range so it won't eat itself up
Else
Exit Sub 'If it's Nothing then get out
End If
End Sub
'-----------------------------
Sub MajorMinor() 'Sub to find Major and minor Headings..headings are in yellow
m = FoundCell.Row
Do Until Sheets(8).Cells(m, 1).Interior.ColorIndex = 6 'Yellow is 6
m = m - 1
Loop
iCol = iCol + 1
Sheets(intSht).Cells(iRow, iCol) = Sheets(8).Cells(m, 1) 'Found First heading; put it in Col 7
Do Until Sheets(8).Cells(m, 1).Interior.ColorIndex = 6 And _
Sheets(8).Cells(m - 1, 1).Interior.ColorIndex = 6 'Find two yellows together
m = m - 1
Loop
iCol = iCol + 1
Sheets(intSht).Cells(iRow, iCol) = Sheets(8).Cells(m - 1, 1) 'Found two yellows together and used the top one
'In col8, if necessary 9 & 10, etc will be used
End Sub
