Search Filter Mapping Matrix - via VBA code

ShuStar

Board Regular
Joined
Sep 9, 2015
Messages
89
Office Version
  1. 2010
Platform
  1. Windows
Hi all,

Really need some support in figuring out how to do this. Any help would be greatly appreciated.

Unfortunately I'm having issues with XL2BB, but in the meantime my excel workbook can be found on this google drive link: Excel - Google Drive

Mapping Filter WorkBook


Context:
In the raw data tab there are Names matched against Fruits which people enjoy. Y is for yes. N is for No.
The Keyword Tab is shortlisted words from the Raw Data Tab - this is static and manually inputted.
Matrix tab - based on the ask below, the mapping is to be plotted here.

The ask:
For each fruit in the Keyword tab, I would like for the VBA code to scan this list cell by cell and match it to any names where it is marked Y in the Raw Data tab; then plot this in the Matrix tab.

Notes:
A - In the keywords tab, they words will always be in Column B, however rows are not fixed; in the example there are 7 words in Column B but sometimes this could be 3 or even 10 or 100 - it depends if the columns in raw data tab increase too; if a fixed range needs to be provided then 500 rows would be a safe bet to fix it at.
B - In the Matrix tab, it should only contain the Names which are impacted by any of the key words (ie not all the names or fruits from Raw Data tab should be included)
C - not looking to resolve this by a Vlookup/Index Match - has to be done by VBA code I'm afraid

Any help in figuring out how this should be would be greatly appreciated (I got stuck trying to create the loop etc).

In the link contains my code but I think I have lost myself - basically i was trying to match the keywords and then do a filter somehow.. nevermind, will hopefully get better with more practice.. probably worth ignoring...
 

ShuStar

Board Regular
Joined
Sep 9, 2015
Messages
89
Office Version
  1. 2010
Platform
  1. Windows
Hi Fluff - an issue I've just stumbled across in the code - if there is only 1 word in the keyword tab, it throws the following error: Runtime error 13 type mismatch

It highlights the below line in yellow:
ReDim OutAry(1 To UBound(DataAry), 1 To UBound(KeyAry) + 2)

I did a spot check with 2 or more keywords and also with 100 or words - it works fine on these scenarios (y)

...only this piece where if there is only 1 word, then it throws the above error.
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,345
Office Version
  1. 365
Platform
  1. Windows
Can you please upload you test file again?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,345
Office Version
  1. 365
Platform
  1. Windows
Ok, how about
VBA Code:
Sub ShuStar()
   Dim KeyAry As Variant, DataAry As Variant, OutAry As Variant
   Dim r As Long, nr As Long, c As Long, Cnt As Long
   Dim nc As Variant
   Dim Flg As Boolean
   
   With Sheets("Keywords")
      KeyAry = Application.Transpose(.Range("B3", .Range("B" & Rows.Count).End(xlUp).Offset(1)).Value2)
   End With
   With Sheets("Raw Data")
      DataAry = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, .Cells(2, .Columns.Count).End(xlToLeft).Column).Value2
   End With
   ReDim OutAry(1 To UBound(DataAry), 1 To UBound(KeyAry) + 2)
   
   For r = 2 To UBound(DataAry)
      For c = 2 To UBound(DataAry, 2)
         nc = Application.Match(DataAry(1, c), KeyAry, 0)
         If Not IsError(nc) And DataAry(r, c) = "Y" Then
            If Not Flg Then
               nr = nr + 1
               Flg = True
               OutAry(nr, 1) = DataAry(r, 1)
            End If
            Cnt = Cnt + 1
            OutAry(nr, nc + 2) = DataAry(r, c)
         End If
      Next c
      If Flg Then OutAry(nr, 2) = Cnt
      Cnt = 0
      Flg = False
   Next r
   With Sheets("Matrix")
      .UsedRange.ClearContents
      .Range("A2:B2").Value = Array("Names", "Count")
      .Range("C2").Resize(, UBound(KeyAry) - 1).Value = KeyAry
      .Range("A3").Resize(nr, UBound(OutAry, 2)).Value = OutAry
   End With
End Sub
 

ShuStar

Board Regular
Joined
Sep 9, 2015
Messages
89
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Thanks mate, brill, has resolved it (y)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,345
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

ShuStar

Board Regular
Joined
Sep 9, 2015
Messages
89
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

I have tried to add a condition to say that if the Keywords in B3 is blank (or theres nothing in the Column B3 and below) then skip this macro. Its worked on other macros i have but for this one it errors.

Basically - if there's no words in B3 in Keywords tab then dont execute this code and skip to next Macro Call.

Code line it errors on after embedding in between main code as below: .Range("A3").Resize(nr, UBound(OutAry, 2)).Value = OutAry

The condition I added:

If IsEmpty(Sheets("Keywords").Range("B3").Value) = True Then

THE MAIN CODE

Else: Exit Sub
End If

End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,345
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
   With Sheets("Keywords")
      If .Range("B3").Value = "" Then Exit Sub
      KeyAry = Application.Transpose(.Range("B3", .Range("B" & Rows.Count).End(xlUp).Offset(1)).Value2)
   End With
 

ShuStar

Board Regular
Joined
Sep 9, 2015
Messages
89
Office Version
  1. 2010
Platform
  1. Windows
Ah great, yes this has resolved it, thanks.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,345
Office Version
  1. 365
Platform
  1. Windows
My pleasure.
 

Watch MrExcel Video

Forum statistics

Threads
1,133,145
Messages
5,657,092
Members
418,355
Latest member
michaelirl

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top