Search Filter Mapping Matrix - via VBA code

ShuStar

Board Regular
Joined
Sep 9, 2015
Messages
69
Office Version
2010
Platform
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.
 

Some videos you may like

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,669
Office Version
365
Platform
Windows
Can you please upload you test file again?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,669
Office Version
365
Platform
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
69
Office Version
2010
Platform
Windows
Thanks mate, brill, has resolved it (y)
 

Fluff

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

ShuStar

Board Regular
Joined
Sep 9, 2015
Messages
69
Office Version
2010
Platform
Windows
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
42,669
Office Version
365
Platform
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
69
Office Version
2010
Platform
Windows
Ah great, yes this has resolved it, thanks.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,669
Office Version
365
Platform
Windows
My pleasure.
 

Watch MrExcel Video

Forum statistics

Threads
1,102,351
Messages
5,486,351
Members
407,541
Latest member
Emilybuhman

This Week's Hot Topics

Top