Export specific content from an existing large range and display unique values

[Gwill1]

Hello there,

I am a new user, but I have been lurking your boards a last few months and really want to start by thanking all contributors, as I managed to go around these past few months with no formal knowledge of VBA. This is all thank to your help and the clarity of your explanations.

If I am posting today, however, it's because I am facing a hurdle I cannot solve. That I cannot solve is not particularly accurate since I found a solution that could work, but it's too demanding on Excel, takes minutes to display results or crashes my Excel.

I am creating an archive of presentations we made for clients. I designed a form for people to input their presentations, which are then all listed individually in a separate worksheet. The following is a shortened version I specifically created for this post.

Export_MrExcel.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	Pitch Name	Date	Keywords	Case 1	Case Description 1	Case 2	Case Description 2	Case 3	Case Description 3	Case 4	Case Description 4
2	Firm A - PPT	20.06.2021	Tourism	A	This is a text for A.	B	This is a text for B.	C	This is a tex for C with a typo.	D	This is a text for D.
3	Firm A - Prezi	07.06.2021	Tourism	A	This is also a text for A.	B	This is a text for B.	D	This is a text for D.	E	This is a text for E!
4	Firm B - PPT	15.01.2021	Tourism; Auto	B	This is a text for B.	Y	Y also has a text.	E	This is a text for E.
5	Firm C - PPT	06.04.2021	E-Commerce; Gardening; Handwork, DIY	E	This is a text for E.	X	X has a text too.	T	T needs a text!	B	The text for B is so awesome.
6	Firm D - Prezi	06.04.2021	E-commerce; Gardening; Handwork	H	This is a text for H.	G	Big text for G.	R	R has a short text too.	D1	D1 is a text connected to D, but the name of D is altered.
7	Firm E - PPT	07.12.2020	Fashion; Sneakers	C	This is a text for C.	O	This is a text for O.	D	This is a text for D, but a different version	F	Do we have a text for F?
8	Firm F	11.06.2021	Fashion; Sustainability; Vegan	D	This is a text for D	T	T needs a text!	B	This is THE text for B.	E	This is a text for E.
Pitches (all)

I am right now working on creating "search engines" that allow employees to look for a specific presentation by looking for the name of the client (I managed to do that), for a list of presentations connected to a specific keyword (I managed to do that).

The last search engine I want to design is the problematic one.
For each presentation, we are presenting "client cases". The client cases we present are not always the same from one presentation to another, and the text we connect to each client case is rewritten from one presentation to another in 75% of the cases.
Therefore, I want to create a search engine that would display all available variants of a given client case, by looking for the client name in the columns called Case 1, Case 2, ....

Since I managed to create the previous two engines with an Excel formula, I tried to repeat the operation to some success using the following formula (might be some syntax mistake as I have to translate it from DE :P) to look in a specific column (line per line):

=IFERROR(INDEX('Pitches (all)'!$A$2:$BK$500;SMALL(IF('Pitches (all)'!$J:$J=$A$2;ROW('Pitches (all)'!$J:$J));ROW('Pitches (all)'!1:1))-1;11);"")

Which I then combined with this VBA code (found on your board) to eliminate duplicates, identify unique values and display them in a column

Sub ColDupes()
Dim MyDict As Object, MyCols As Variant, OutCol As String, LastRow As Long
Dim InputSh As Worksheet, OutputSh As Worksheet
Dim x As Variant, i As Long, MyData As Variant

    Set MyDict = CreateObject("Scripting.Dictionary")

    Set InputSh = Sheets("SEARCH - Cases")
    MyCols = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P")
    
    Set OutputSh = Sheets("SEARCH - Cases")
    OutCol = "A"
    
    For Each x In MyCols
        LastRow = InputSh.Cells(Rows.Count, x).End(xlUp).Row
        MyData = InputSh.Range(x & "1:" & x & LastRow).Value
        For i = 1 To UBound(MyData)
            If MyData(i, 1) <> "" Then MyDict(MyData(i, 1)) = 1
        Next i
    Next x

    OutputSh.Range(OutCol & "5").Resize(MyDict.Count, 1).Value = WorksheetFunction.Transpose(MyDict.keys)
    
End Sub

This worked perfectly fine in principle. I put my formula in 15 columns (I have a maximum of 15 cases per presentation) to check and display results if they found any, and the script cleaned and display them properly.

The core of my problem is right now, I have already 164 presentations (more and more are coming in everyday) and my approach seems to be too demanding for Excel, who has to first display all results in a sheet (potentially 164x15) before cleaning them.

Therefore a simple question: can you guys think of some sort of VBA wizardry that would allow me to:
- look for a keyword (typed in a cell) simultaneously in up to 15 columns
- for each positive hit, retrieve the content of the cell that is directly to their right
- check this content for duplicate (even if the difference is a typo or a punctuation sign, I want to have it)
- display the results either in a row or a line (I don't know if there is a possibility to display it on like 5 columns and as many rows as needed)

I am really sorry for this wall of text, but I have been trying to find a solution for it the entire day and I'm forced to wave the white flag and ask for support from professionals or people with a lot more experience than I have with Excel.

 

[Gwill1]

Selfish bump in the early European morning, as I will get back to work on it for the next 8 hours, desperately trying to figure out what to do. :D

 

[Gwill1]

I am still trying to find a solution "on my own".

My researches got me to that point:

Sub FindAndExecute()

Dim FoundAt As Range
Set FoundAt = Worksheets("Pitches (all)").Columns("D").Find(What:="Firm A", LookIn:=xlValues, LookAt:=xlWhole)

        If Not FoundAt Is Nothing Then
            Do Until FoundAt Is Nothing
                Worksheets("SEARCH - Cases (2)").Range("A" & Rows.Count).End(xlUp)(2).Value = FoundAt.Offset(ColumnOffset:=1).Value
                Set FoundAt = .FindNext(FoundAt)
            Loop
    Else
            MsgBox "We could not find this reference.", vbCritical
        End If
    End With
    Set Loc = Nothing
Next

End Sub

As a test run, I wanted to try and look for all occurences of case A in the column D and export the corresponding texts in column E to the row after the last row with content in column A in a different Worksheet.

But for some reason, I get an error message for "Set FoundAt = .FindNext(FoundAt)" which roughly translates in "error during compilation: invalid or insufficiently defined reference"

Any idea?

 

[Marc L]

​

According to VBA help you obviously forgot a range reference before FindNext statement …​

 

[Gwill1]

​

According to VBA help you obviously forgot a range reference before FindNext statement …​

Hello Marc and thanks for your answer!

OK, this makes sense with the error message but I am a bit confused then: I define the range FoundAt earlier in the code, and it's the only range I use.

If I take out that part of the code, it executes perfectly (because it only has to find one occurence) so I must be missing something in the syntax and/or parameters for FoundAt but I do not see what. :/

 

[Gwill1]

Hello Marc and thanks for your answer!

OK, this makes sense with the error message but I am a bit confused then: I define the range FoundAt earlier in the code, and it's the only range I use.

If I take out that part of the code, it executes perfectly (because it only has to find one occurence) so I must be missing something in the syntax and/or parameters for FoundAt but I do not see what. :/

So, I took the hint and went back to learn exactly how the whole thing was supposed to work.

I came up with the following code, which works!

 Sub FindNext_Example()
 
 
 Dim FindValue As String
 FindValue = Worksheets("SEARCH - Cases (2)").Range("$A$2").Value

 Dim Rng As Range
 Set Rng = Worksheets("Pitches (all)").Columns("D; ")

 Dim FindRng As Range
 Set FindRng = Rng.Find(What:=FindValue)

 Dim FirstCell As String
 FirstCell = FindRng.Address

 Do
  Worksheets("SEARCH - Cases (2)").Range("A" & Rows.Count).End(xlUp)(2).Value = FindRng.Offset(ColumnOffset:=1).Value
  Set FindRng = Rng.FindNext(FindRng)
  Loop While FirstCell <> FindRng.Address

 MsgBox "Search is over"

End Sub

Now, I just need to apply it to all columns.

 

[Marc L]

The other way is to use a With block like in the Range.Find VBA help sample …​