Search Filter Mapping Matrix - via VBA code

[ShuStar]

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]

Hi, I've realised I need to place the ID whenever the matrix is populated, which will come from D3 in the Keywords tab (it will always be numeric ID - not sure of length). The ID in D3 will be inputted manually and no VBA code needed to generate it.

This ID sitting in D3 within the Keywords Tab, how can the code be amended so that the table populated in the Matrix sheet looks something as below:

ID	Name	Count	Apples	Banana	Nectarine	Strawberry
12345678910	John	3	Y		Y	Y
12345678910	Barry	4	Y	Y	Y
12345678910	Tom	4	Y	Y	Y	Y
12345678910	Sarah	2		Y	Y

 

[Fluff]

How about

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, IdNum As Long
   Dim nc As Variant
   Dim Flg As Boolean
   
   With Sheets("Keywords")
      If .Range("B3").Value = "" Then Exit Sub
      IdNum = .Range("D3").Value
      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) + 3)
   
   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) = IdNum
               OutAry(nr, 2) = DataAry(r, 1)
            End If
            Cnt = Cnt + 1
            OutAry(nr, nc + 3) = 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]

Thanks for this but unfortunately that has not worked - the output in the matrix tab becomes skewed (names is overwritten with the ID and the plotting of Ys is misaligned).

Please see images below:

Results below: when an ID is placed in Keywords tab cell D3

Results below: when cell D3 is blank in Keywords tab (side note: if D3 is blank, instead of a 0 being plot, is it possible to input "No ID" instead?)

 

[Fluff]

Try

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, IdNum As Long
   Dim nc As Variant
   Dim Flg As Boolean
   
   With Sheets("Keywords")
      If .Range("B3").Value = "" Then Exit Sub
      IdNum = .Range("D3").Value
      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) + 3)
   
   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) = IdNum
               OutAry(nr, 2) = DataAry(r, 1)
            End If
            Cnt = Cnt + 1
            OutAry(nr, nc + 3) = DataAry(r, c)
         End If
      Next c
      If Flg Then OutAry(nr, 3) = Cnt
      Cnt = 0
      Flg = False
   Next r
   With Sheets("Matrix")
      .UsedRange.ClearContents
      .Range("A2:c2").Value = Array("ID", "Names", "Count")
      .Range("d2").Resize(, UBound(KeyAry) - 1).Value = KeyAry
      .Range("A3").Resize(nr, UBound(OutAry, 2)).Value = OutAry
   End With
End Sub

 

[ShuStar]

Thanks for this it has now resolved it (plots properly in matrix tab), except when I placed a larger ID number it throws an error (the LEN of the ID below is 17) - please see image below.

Is there a way it can bypass this and not throw an error?

 

[Fluff]

In that case change IDNum to variant.

 

[ShuStar]

Thank you, yes thats resolved it!

 

[Fluff]

My pleasure.

 

[ShuStar]

Hi Fluff,

Separate the above code - but linked to it, i wanted to create a new Sub to try do the following:

The Ask: For each column, starting from D3 to Column X, replace the values of Y in each row reflect that of the column header.
ie if D3 Column header is Banana and D4 has Y, then it should replace D4 to be Banana, but dynamically do this as the Columns and Rows always change when we execute original code.

Current view:

ID	Name	Count	Banana	Apples	Nectarine
12345	John	1	Y
12345	Sara	3	Y	Y	Y
12345	Alex	2	Y	Y

New Sub to amend to:

ID	Name	Count	Banana	Apples	Nectarine
12345	John	1	Banana
12345	Sara	3	Banana	Apples	Nectarine
12345	Alex	2	Banana	Apples

My code where I can't seem to get passed Range(startcolumn, "D"&lastrow).select as it keeps erroring out here:

Sub changeYtorespectiveColumnName()

Dim lastrow As Long
Dim lastcolumn As Long
Dim startcolumn As Variant
Dim startingRange As Range
Dim InbtColumn As Long
Dim selectrange As Long
Dim i As Integer

Dim sht As Worksheet

Set sht = Sheets("Matrix")

lastrow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row - 1
lastcolumn = sht.Cells.SpecialCells(xlCellTypeLastCell).Column
startcolumn = Cells(3, 4).Range
Range(startcolumn, "D" & lastrow).Select
startingRange.Select

'For each column
For j = 1 To lastcolumn

'scan through each row and if the value equals Y, then replace it with the title of the column header
For i = 1 To lastrow


Next i

Next j



End Sub

 

[Fluff]

You will need to start a new thread for this. When you do please ensure that you post the code using code tags.