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

Gwill1

New Member
Joined
Jun 25, 2021
Messages
5
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
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
ABCDEFGHIJK
1Pitch NameDateKeywordsCase 1Case Description 1Case 2Case Description 2Case 3Case Description 3Case 4Case Description 4
2Firm A - PPT20.06.2021TourismAThis is a text for A.BThis is a text for B.CThis is a tex for C with a typo.DThis is a text for D.
3Firm A - Prezi07.06.2021TourismAThis is also a text for A.BThis is a text for B.DThis is a text for D.EThis is a text for E!
4Firm B - PPT15.01.2021Tourism; AutoBThis is a text for B.YY also has a text.EThis is a text for E.
5Firm C - PPT06.04.2021E-Commerce; Gardening; Handwork, DIYEThis is a text for E.XX has a text too.TT needs a text!BThe text for B is so awesome.
6Firm D - Prezi06.04.2021E-commerce; Gardening; HandworkHThis is a text for H.GBig text for G.RR has a short text too.D1D1 is a text connected to D, but the name of D is altered.
7Firm E - PPT07.12.2020Fashion; SneakersCThis is a text for C.OThis is a text for O.DThis is a text for D, but a different versionFDo we have a text for F?
8Firm F11.06.2021Fashion; Sustainability; VeganDThis is a text for DTT needs a text!BThis is THE text for B.EThis 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):

Excel Formula:
=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

VBA Code:
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.
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
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
 
Upvote 0
I am still trying to find a solution "on my own".

My researches got me to that point:

VBA Code:
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? :(
 
Upvote 0
According to VBA help you obviously forgot a range reference before FindNext statement …​
 
Upvote 0
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. :/
 
Upvote 0
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! :)

VBA Code:
 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. :)
 
Upvote 0

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

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

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
Back
Top