Fill cells based on other table - vba

Question

I'm trying to automate certain functions in an Excel file.
Here is my issue:
Table 1 contains a string is Column "Info", followed by two empty cells. For each of the rows in Table 1, I want to check if a value of Table 2, Column "Fruit" exists in column "Info" of Table 1. If so, I would like to fill in the "Color" and "Price" of Table 2 in the empty cells in Table 1.
For example, the second row contains the word "bananas", which means "Color" "Yellow" and "Price" "15" should be filled in the same columns in Table 1, row 2.
Somehow this issue seems so simple to me, but when I start to think of how to implement this, I get stuck. So unfortunately, I don't have any code available to fix. I just hope this issue isn't too vague.
I've also tried solving this issue using formulas, using MATCH and INDEX, but I couldn't get that to work either.

Answer 1

Here's a function that will return the row in the ListObject (Table) where the first matching word is found.
Public Function MatchFruit(ByVal sInfo As String, ByRef rFruit As Range) As Long
Dim vaSplit As Variant
Dim i As Long, j As Long
Dim rFound As Range
Dim sWhat As String
vaSplit = Split(sInfo, Space(1))
For i = LBound(vaSplit) To UBound(vaSplit)
'strip out non-alpha characters
sWhat = vbNullString
For j = 1 To Len(vaSplit(i))
If Asc(Mid(LCase(vaSplit(i)), j, 1)) >= 97 And Asc(Mid(LCase(vaSplit(i)), j, 1)) <= 122 Then
sWhat = sWhat & Mid(vaSplit(i), j, 1)
End If
Next j
'find the word in the range
Set rFound = Nothing
Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False)
If Not rFound Is Nothing Then 'if it's found
'return the row in the ListObject
MatchFruit = rFound.Row - rFruit.ListObject.HeaderRowRange.Row
'stop looking
Exit For
End If
Next i
End Function
Assuming your first table is called tblData and your second table tblFruit, you would get the color using
=INDEX(tblFruit[Color],MatchFruit([#Info],tblFruit[Fruit]))
and the price similarly
=INDEX(tblFruit[Price],MatchFruit([#Info],tblFruit[Fruit]))
Long Explanation
The vaSplit assignment line uses the Split function to convert a string into an array based on a delimiter. Since your sample data was sentences, the normal delimiter is a space to split it into words. A string like
This is some line about apples.
is converted to an array
vaSplit(1) This
vaSplit(2) is
vaSplit(3) some
vaSplit(4) line
vaSplit(5) about
vaSplit(6) apples.
Next, the For loop goes through every element in the array to see if it can find it in the other list. The functions LBound and Ubound (lower bound and upper bound) are used because we can't be sure how many elements the array will have.
The first operation inside the loop is to get rid of any extraneous characters. For that, we create the variable sWhat and set it to nothing. Then we loop through all the characters in the element to see if any are outside of the range a...z. Basically, anything that's a letter gets appended to sWhat and anything that's not (a number, a space, a period) doesn't. In the end sWhat is the same as the current element with all non-alpha characters stripped out. In this example, we'd never match apples. because of the period, so it's stripped away.
Once we have a good sWhat, we now use the Find method to see if that word exists in the rFruit range. If it does, then rFound will not be Nothing and we move ahead.
Note that if it doesn't find the word in the range, then rFound will be Nothing and the function will return zero.
If the word is found, the function returns the row it was found on less the row where the ListObject starts. That way the function returns what row it is withing the data of the ListObject not on the worksheet. This is useful when incorporating into an INDEX formula. To make a formula return something, you assign that something to the formula's name.
Finally, the Exit For line simply stops looking through the array once a match was found. If you have more than one match in your data, it will only return the first one.
Troubleshooting
The most likely error that you'll find is that the function will return zero when you expect it to return a row number. That most likely means it did not find any words in the list.
If you're certain that both lists contain a matching word, here's how you troubleshoot it: After the Set rFound = line put a Debug.Print statement.
Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False)
Debug.Print "." & sWhat & "."
If Not rFound Is Nothing Then 'if it's found
That will print sWhat to the Immediate Window (Ctrl+G in the VBE to see the Immediate Window). The periods around the word are so you can see any non-printable characters (like spaces). If you try to match .pears . with pears it won't match because the first one has a space at the end - and you can see that because we stuck periods before and after.
If spaces are going to be a problem, you can use the Trim$() function on sWhat to get rid of them first.
With that Debug.Print statement, you might see results like
.paers.
in which case would recognize that you have a typo.

Answer 2

To Dick and other people who may be interested. Like I mentioned in my last comment on the answer provided by #Dick-Kusleika, his answer didn't fully cover my initial question. Even though it gave me great insight and it did the job of filling the empty cells with the appropriate data, I was really looking for something that would do it automatically, without me having to copy-paste any formulas. So I spent some more time trying to figure it out, getting info from the internet and sparring with a colleague who shares my interest in this. And eventually I managed to get it working! (hurray!!)
Below is my solution. As I'm still a beginner, I probably did a few things that could have been done better or cleaner. So I'm really interested in your opinion about this and would love to hear any remarks or tips.
Sub check_fruit()
Dim ws As Excel.Worksheet
Dim lo_Data As Excel.ListObject
Dim lo_Fruit As Excel.ListObject
Dim lr_Data As Excel.ListRow
Dim lr_Fruit As Excel.ListRow
Dim d_Info As Variant
Dim f_Fruit As Variant
Set ws = ThisWorkbook.Worksheets("Exercise")
Set lo_Data = ws.ListObjects("tblData")
Set lo_Fruit = ws.ListObjects("tblFruit")
For Each lr_Data In lo_Data.ListRows
'check if field "Color" is empty in tblData'
If IsEmpty(Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value) Then
d_Info = Intersect(lr_Data.Range, lo_Data.ListColumns("Info").Range).Value
For Each lr_Fruit In lo_Fruit.ListRows
f_Fruit = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Fruit").Range).Value
'check for each row in tblFruit if value for field "Fruit" exists in field "Info" of tblData'
If InStr(1, d_Info, f_Fruit, vbTextCompare) <> 0 Then
Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Color").Range).Value
Intersect(lr_Data.Range, lo_Data.ListColumns("Price").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Price").Range).Value
End If
Next lr_Fruit
End If
Next lr_Data
End Sub