Help! Novice trying to do intermediate work!

[penguin1]

I will try to explain this as best I can. I will upload my excel sheet to my website so that anyone who wants to try to help can see what I am talking about. The address is:

http://www.entertainerdj.com/help.xls

I appreciate any ideas on this. Here is the task. There are 8 worksheets in this excel workbook.

I need to look at each part number (Column A) in each of the first seven sheets and see if they match a number in Column B of sheet 8 labeled 'Voith Part'. If they DO match, I need to copy the heading which is highlighted in yellow above the matched number and paste it into column G of the worksheet that I was matching from. This way if there was a match, the heading would appear on the same line in all of the first seven sheets as the item that was matched. Then, to make things more complicated, I have to repeat the entire process with the 'Description' filed (Column C in the first 7 sheets) and see if they match the descriptions in Column A of sheet 8. I only want to check items that did not find a match with the part number. Do not bother looking at highlighted cells in sheet 8. I have spent all day on this and have gotten nowhere! I have done some visual basic a while ago and know excel well enough to do all the basics, but the macros somehow elude me. I hope that this can be done somehow and I would prefer doing it with formulas instead of macros if possible, but I sure couldn't figure out how! Thanks in advance for all your help. I hope someone will take this on. Please look for the file at the web location above in a couple of hours.

Thank you,

Bob

[ This Message was edited by: penguin1 on 2002-03-12 15:50 ]

[ This Message was edited by: penguin1 on 2002-03-13 07:56 ]

[penguin1]

I have uploaded the file. I hope someone will check it out and give me some direction!

Thanks again, the link should work now.

Here it is:

http://www.entertainerdj.com/help.xls



[ This Message was edited by: penguin1 on 2002-03-12 14:36 ]

[JerryP]

I think you will have to use a VB script. I am not proficient at these, but I can't see any way to do what you want with simple, (or even complicated) formulas. Maybe someone else can help with the visual basic stuff.

Sorry not more help,

JP

[penguin1]

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