Find, group and rename data based on a word (of several) in cell

[Oth]

Hi all, I am new to the board and this is my first own post..
First I need to thank you all for the help you have already given me over the years when I have searched for solutions - this is truly an amazing source of information!!

I have searched long for the solution but I might have used the wrong terminology..?

I basically want to group stuff from table (A-D) of 10K items, rename them according to a template and create a new shorter list (G-J). ((Every month I will get a new A-D list))

The words I am looking for (in this exmple the fruits) can be anywhere in the cell. The cells might include many kind of signs (*/-., etc).
In some situations (as in A5) two of the searched words might be in the cell - are there options on how to solve that?
I understand I might need to create a lookup/group list of some sort but am not sure how to do it.
I can not change the original list unfortunately - so any clean up of that
has to be simple enough for me to handle it.

If you have time and ability to help, please remember I am a novice on excel.
Thanks in advance.

I am now attempting to use MR excel html to show you a view of what the problem is (no formulas in the example):

Excel Workbook
	A	B	C	D	E	F	G	H	I	J
1	Original list						Result in new list
2	Sold products	Jan	Feb	March		how I want it grouped:	Product groups	Jan	Feb	March
3	Applepie	2	5	2		Apple	Apple products	24	32	27
4	Apples	4	2	3		Banana (what happens to the Apple and banana pie?)	Banana products	26	14	7
5	pie.-Apple and banana	2	8	6		Lemon + Meat	Other products	24	24	21
6	Applesauce	7	5	7		Any other	Specials	5	6	8
7	XXapple-sauce	6	4	9			Total sum	79	76	63
8	apple* cjd* juice	3	8	0
9	Candy kkns	2	2	3
10	Bananas	19	7	1
11	bananacurry	4	3	5		Searching for a solution compatible with Excel 2003
12	chicken with bananas	3	4	1		If not doable in 2003 - is it doable in 2007 or 2010?
13	lemon	9	7	0		Original list is ca 10k items
14	lemon-curd	1	3	4		Colors are only for showing here.
15	chicken with lemons	2	3	5
16	Meatloaf	3	3	3
17	Meat loaf	4	4	4
18	Meat-pie	5	4	5
19	potatoes	3	4	5
20	Total	79	76	63
Sheet1

Cell Formulas
Range	Formula
H7	=SUM(H3:H6)
I7	=SUM(I3:I6)
J7	=SUM(J3:J6)
B20	=SUM(B3:B19)
C20	=SUM(C3:C19)
D20	=SUM(D3:D19)

 

[Oth]

Ah, you think a macro of advanced filters could be automated and be fitted on a list and then run every month. hmmm.

 

[Gary McMaster]

macro of advanced filters could be automated and be fitted on a list and then run every month

Exactly!

However, I believe there is some kind of limit as to how much code you can have in a module. The macro recorder is horribly inefficient and you would probably run out of space if you tried to get it to record the whole process. It would duplicate code every time you applied a new filter. That duplication could be reduced to a single loop and accept search parameters (maybe a list of keywords from another sheet).

Gary

 

[Oth]

Great. A keyword list search/match would be a great solution if possible!
I guess that in my example - it would be apple, banana, lemon + meat?
(and in my real scenario it would be a keyword list of ca 4-5000 words).

Any clues (from anyone) on which solution/technique that will be easiest to maintain on a monthly basis would be much appreciated!

 

[Gary McMaster]

Keep in mind that I was trying to offer a non-code solution. "Auto Filtering" may not be the best code solution. There is also "Find". "Filtering" may in fact actually use "Find" deep down inside its mysterious mechanism. After all, something has to "find" the matches. Using code you would not have to hide rows, update the display etc like the "Auto Filter" tool does. Something else like "find" may be much faster.

Gary

 

[Oth]

I understand, thanks Gary.
I was myself hoping for a "quick" solution. But when considering the dynamics and data volumes it seems some form of code solution is needed.
Quite complex problem I got.

 

[Gary McMaster]

Here's a quicky you can try. It's based on the row & column positions shown in your original post.

You need to add a worksheet named "Keywords" and list the words you want to find in column A starting in A1 of the "Keywords" sheet. You can hide the "Keywords" sheet if you want.

The code is expecting your original sheet to be named "Sheet1". Either rename your sheet to "Sheet1" or change the name in the code (right after the Dim ... statements) to match your sheet name.

Paste the code in a standard module.

Since it will write to your sheet, please be sure to test it on a backup copy of your work.

I hope this will at least serve as a starting point.

Gary

Public Sub Test()

Dim oProduct As Worksheet
Dim oKeywords As Worksheet

Dim oWordList As Range
Dim oSearch As Range
Dim oFound As Range
Dim oOutput As Range
Dim oWord As Range

Dim lLastRow As Long
Dim sAddress As String

Dim lSumB As Long
Dim lSumC As Long
Dim lSumD As Long

'Change "Sheet1" (below) to product list actual sheet name
Set oProduct = ThisWorkbook.Worksheets("Sheet1")

'Add worksheet named "Keywords" and list words starting in A1
Set oKeywords = ThisWorkbook.Worksheets("Keywords")

'Find last used row, column A, "Sheet1"
lLastRow = oProduct.Range("A" & Rows.Count).End(xlUp).Row
Set oSearch = oProduct.Range("A3:A" & lLastRow) ' Search for keywords in column A

'Find last used row, column A, "Keywords" worksheet
lLastRow = oKeywords.Range("A" & Rows.Count).End(xlUp).Row
Set oWordList = oKeywords.Range("A1:A" & lLastRow)

Set oOutput = oProduct.Range("G3") 'Start output here

For Each oWord In oWordList ' Loop thru each word in keyword list

    Set oFound = oSearch.Find(oWord.Text, LookIn:=xlValues, MatchCase:=False) 'Case insensitive
    
    If Not oFound Is Nothing Then
    
        sAddress = oFound.Address ' Remember start address of first find, loop until revisited
        
            Do
                Set oFound = oSearch.FindNext(oFound)
                If Not oFound Is Nothing Then ' Sum values in cols B,C & D of found row
                    lSumB = lSumB + oFound.Offset(0, 1).Value
                    lSumC = lSumC + oFound.Offset(0, 2).Value
                    lSumD = lSumD + oFound.Offset(0, 3).Value
                End If
            'Keep using find next until roll around to first find
            Loop While Not oFound Is Nothing And oFound.Address <> sAddress
            
    End If
    
    oOutput.Value = oWord.Value 'Display search word in output section
    
    'Display sums of columns B,C & D in output section
    oOutput.Offset(0, 1).Value = lSumB
    oOutput.Offset(0, 2).Value = lSumC
    oOutput.Offset(0, 3).Value = lSumD
    
    Set oOutput = oOutput.Offset(1, 0) ' Move down to next row
    
    lSumB = 0: lSumC = 0: lSumD = 0 'Zero sums
    
Next oWord

End Sub

 

[Oth]

Wow nice, thanks Gary!
Been out cold for over a week... will try this out early next week.
Looks very interesting!