VBA Solution to Search Text and Return Desired Result

plk0507 · Dec 15, 2021

Hi,

First-time poster so I want to say thank you in advance for looking at my issue. Below is a sample from my worksheet that is actually hundreds of thousands of lines long.

I'm looking for a solution to search columns J, K, and L for the values in column Y (column y is actually 5-6 thousand lines long). And if it finds the value, return it to column M, separated by a comma.

I've been using the following formula: =TEXTJOIN(", ", TRUE, IF(COUNTIF(J2:L2, "*"&$Y$2:$Y$9&"*"), $Y$2:$Y$9, ""))

My issue with that formula is it also returns partial matches. For example, look at the result in M3. It returned W269 simply because it's a partial match to W2690. On a file with 900 thousand lines, that partial match could repeat itself a few thousand times, and manually fixing it can take days. My other issue is running that formula can take a couple of hours.

My question is, is there a VBA solution to searching this data that will return the desired result without the partial matches? Thank you for your help, I sincerely appreciate it.

Book1.xlsx

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

1

Aircraft Type

Tail Number

JCN

WCE ID

WUC

How Mal

Action Taken

When Discovered Code

Type Maint Code

Corrective Action

Discrepancy

WCE Narrative

Harness

RDI

Start Date

Stop Date

Labor

Base

Units Produced

How Mal Class

Block Number

Harness Number

2

F016D

8900002171

151550276

1

62000

799

X

F

B

VHF OPS CHK C/W

VHF AUDIO HARNESS W1654 PART NUMBER H16DW1654-504,W1644 PART NUMBER H16DW1644-514 AND W1844 PART NUMBER H16DW1844-300 REQUIRE REPLACEMENT.

W1644, W1654, W1844

42799.71

42799.75

2

KUNSAN

1

6

40

W1644

3

F016D

9000000783

203510534

0

63000

6

F

S

R

RECOUP HOURS FOR: SOLDER NEW WAFER ON TO WIRES TO REPAIR W1812-9154J424. PERFORM CONTINUITY CHECK TO ENSURE PROPER CONNECTIONSREF 1F-16CG-2-00GV-00-2

***ADD TIME REQ, REF OP#91438*** NSFE FOUND DURING INSTALL OF HARNESS 16DW2690-501 BROKEN PINS WERE FOUND ON W1812-9154J424 T.O./FIG:REF 1F-16CG-2-00GV-00-2

W269, W1812, W2690

44181

44.3

HILL AFB UT

1

42

W1654

4

F016D

9000000783

203490427

0

63000

6

F

S

R

SOLDER NEW WAFER ON TO WIRES TO REPAIR W1812-9154J424. PERFORM CONTINUITY CHECK TO ENSURE PROPER CONNECTIONSREF 1F-16CG-2-00GV-00-2

NSFE FOUND DURING INSTALL OF HARNESS 16DW2690-501 BROKEN PINS WERE FOUND ON W1812-9154J424 T.O./FIG:REF 1F-16CG-2-00GV-00-2

W269, W1812, W2690

44179

6

HILL AFB UT

1

42

W1844

5

F016D

8900002166

150567407

2

64000

799

X

D

SEE NEW JCN 161896706 FOR UPDATED JOB

COM 2 RADIO TRANSMITS SQUEAL/TONES WHEN MIC IS KEYED, IF VOLUME KNOB IS PAST 3:00 POSITION. VOLUME ANY LOWER AND COM 2 IS INAUDIABLE

JOB CREATED TO ORDER AND REPLACE VHF AUDIO HARNESS W1654 PART NUMBER H16DW1654-504,W1644 PART NUMBER H16DW1644-514 AND W1844 PART NUMBER H16DW1844-300.

W1644, W1654, W1844

42563.25

42563.29

2

KUNSAN

1

6

40

W269

6

F016D

8800000170

210889170

8

69B98

70

R

B

W2690-204-20 R2 IAW 1F-16CG-2-00GV-00-2 SECTION 14

PANEL 3434 & 3436 REMOVED TO FOM SEE JCN 210550032001

W2690-204-20 SHOOTS OPEN FROM RPS 2382P2/1 TO LVT 2382P12

W269, W2690

2382P12, 2382P2/1

44286.71

44286.73

1

EGLIN AFB FL

1

40

W1812

7

F016D

8800000170

210670228

14

69B98

308

R

B

FILL PORT HARNESS R2 IAW 1F-16CG-2-00GV-00-2 PARA 14.7

MIDS 006,012,029,031,035,056,074,075 MFL'S. TACAN WORKED FINE

H16DW2693P4/1 REMOVED FOR REPLACEMENT

W269, W2693

44279.79

44280.13

24

EGLIN AFB FL

1

40

W2690

8

F016D

8900002162

210630128

10

69B00

800

S

F

B

REINSTALLED CABLE H16DW2682-600 IAW (PARA 14.8 00GV-2)

GUN REQ REM FOR JAM

REMOVED CABLE H16DW2682-600 TO FOM

W268, W2682

44263.67

44263.71

2

HOLLOMAN

1

6

42

W268

9

F016D

9000000783

203510537

0

69000

800

S

R

RECOUP HOURS FOR: INSTALL WIRE HARNESS 16DW2690-501 IN GUN DRUM IAW 16D40730.DOCUMENT STEPS AND TIME OF EACH STEP ON ATTACHED 959

***ADD TIME REQ, REF OP#91427*** NSFE WIRE HARNESS 16DW2690-501 FOUND UNINSTALLED. T.O./FIG:IAW 16D40730

W269, W2690

44181

2.1

HILL AFB UT

1

6

42

W2682

10

F016D

9000000783

203490429

0

69000

800

S

R

INSTALL WIRE HARNESS 16DW2690-501 IN GUN DRUM IAW 16D40730.DOCUMENT STEPS AND TIME OF EACH STEP ON ATTACHED 959

NSFE WIRE HARNESS 16DW2690-501 FOUND UNINSTALLED. T.O./FIG:IAW 16D40730

W269, W2690

44179

4

HILL AFB UT

1

6

42

11

F016D

8900002167

200722167

3

69B00

20

R

F

B

R2 HARNESS IAW 1F-16CG-2-00GV-00-2 CHAPTER 14

238282 P1/4 SMASHED, REQUIRES REPLACEMENT

W2690-; 2382P3/3 & 2382P6 INNER WIRE EXPOSED REQUIRE REPLCMENT; 2382P2/1 MISSING GRNDING FSTNER AND 2382P3/3 WORN GRNDING FSTNER NUT REMAIN LOOSE AFTER TIGHTENING PN(H16DW2690-501)

W269, W2690

2382P3/3, 2382P2/1, 2382P6

43909.5

43909.83

24

TULSA

1

42

Sheet2

plk0507 · Dec 16, 2021

MoshiM said:

My apologies for spamming. I just keep finding better ways to write the code.

VBA Code:

Sub Harness_Search()

'=TEXTJOIN(", ", TRUE, IF( COUNTIF(J2:L2, "*"&$Y$2:$Y$9&"*"), $Y$2:$Y$9, ""))
Dim input_data() As Variant, X As Long, Y As Long, output() As String, ITR As Variant, T As Long, _
harness_numbers() As Variant, Z As Long, value() As String, Comparison_CLCTN As New Collection, Query As Collection, row_str As String

With ThisWorkbook.ActiveSheet

    input_data = .Range("J2", "L" & .UsedRange.Rows.Count).Value2 'Data from columns J through L
   
    ReDim output(LBound(input_data, 1) To UBound(input_data, 1), 1 To 1)
   
    Comparison_CLCTN.Add Array("Y", "M") 'Source of codes followed by output column
    Comparison_CLCTN.Add Array("Z", "N") 'Source of codes followed by output column
   
    For Z = Comparison_CLCTN.Count To 1 Step -1
   
        ITR = Comparison_CLCTN(Z)
       
        Set Query = New Collection
        
        Query.Add .Range(ITR(0) & "2", .Cells(.Rows.Count, ITR(0)).End(xlUp)).Value2, "CODES"
        Query.Add .Range(ITR(1) & "2", ITR(1) & .UsedRange.Rows.Count), "DESTINATION RANGE"
       
        Query.Add output, "OUTPUT"

        Comparison_CLCTN.Remove Z
        Comparison_CLCTN.Add Query
       
    Next Z
   
End With

Const delimiter As String = ", "

With Comparison_CLCTN

    For X = LBound(input_data, 1) To UBound(input_data, 1) 'Loop each ROW of columns J through L
   
        row_str = vbNullString
       
        For Y = LBound(input_data, 2) To UBound(input_data, 2) 'Loop each COLUMN from J to L and generate a string to be searched
            row_str = row_str & "|" & input_data(X, Y)
        Next Y
       
        If Not row_str = vbNullString Then
       
            For T = 1 To .Count 'Loop Comparison_CLCTN
           
                With .Item(T) 'With given values of (codes,destination ranges,etc)
                   
                    harness_numbers = .Item("CODES")
                    output = .Item("OUTPUT")
                   
                    For Z = LBound(harness_numbers, 1) To UBound(harness_numbers, 1) 'Loop though each Harness Number from column Y
                        'patterns:
                        'Any string + code + any non-alphanumeric character + Any string(includes empty string)
                        'Any string + code
                       
                        If Not harness_numbers(Z, 1) = Empty _
                        And (row_str Like "*" & harness_numbers(Z, 1) & "[!A-Za-z0-9]*" _
                            Or row_str Like "*" & harness_numbers(Z, 1)) Then
                           
                            output(X, 1) = output(X, 1) & IIf(output(X, 1) = Empty, vbNullString, delimiter) & harness_numbers(Z, 1)

                        End If
                       
                    Next Z
                   
                    If Not output(X, 1) = Empty Then 'If pattern matches were found
                        .Remove "OUTPUT"
                        .Add output, "OUTPUT"
                    End If
                   
                End With
               
            Next T
               
        End If
       
        If X Mod 3000 = 0 Then DoEvents 'Allow user interaction with Excel every 3000 loops
       
    Next X

End With

With ThisWorkbook.ActiveSheet
    For Each ITR In Comparison_CLCTN
        ITR("DESTINATION RANGE").Value2 = ITR("OUTPUT")
    Next ITR
End With

MsgBox "Search Completed."

End Sub

I tried it on a small 20k line file and it worked beautifully. But when I tried it on an 800k line file, I got Run Time Error 13, Type Mismatch.

MoshiM · Dec 16, 2021

plk0507 said:
I tried it on a small 20k line file and it worked beautifully. But when I tried it on an 800k line file, I got Run Time Error 13, Type Mismatch.

On which line?

plk0507 · Dec 16, 2021

MoshiM said:
On which line?

I'm not sure I know what I'm doing. But when I click Debug, the following line is highlighted. row_str = row_str & "|" & input_data(X, Y)

The data I'm searching for is in Y, Z. But it worked on the smaller file?

MoshiM · Dec 16, 2021

plk0507 said:
I'm not sure I know what I'm doing. But when I click Debug, the following line is highlighted. row_str = row_str & "|" & input_data(X, Y)

The data I'm searching for is in Y, Z. But it worked on the smaller file?

Interesting try this and reply with the contents of the message it shows you.

VBA Code:

Sub Harness_Search()

'=TEXTJOIN(", ", TRUE, IF( COUNTIF(J2:L2, "*"&$Y$2:$Y$9&"*"), $Y$2:$Y$9, ""))
Dim input_data() As Variant, X As Long, Y As Long, output() As String, ITR As Variant, T As Long, _
harness_numbers() As Variant, Z As Long, value() As String, Comparison_CLCTN As New Collection, Query As Collection, row_str As String

With ThisWorkbook.ActiveSheet

    input_data = .Range("J2", "L" & .UsedRange.Rows.Count).Value2 'Data from columns J through L
   
    ReDim output(LBound(input_data, 1) To UBound(input_data, 1), 1 To 1)
   
    Comparison_CLCTN.Add Array("Y", "M") 'Source of codes followed by output column
    Comparison_CLCTN.Add Array("Z", "N") 'Source of codes followed by output column
   
    For Z = Comparison_CLCTN.Count To 1 Step -1
   
        ITR = Comparison_CLCTN(Z)
       
        Set Query = New Collection
        
        Debug.Print .Range(ITR(0) & "2", .Cells(.Rows.Count, ITR(0)).End(xlUp)).Address
        
        Query.Add .Range(ITR(0) & "2", .Cells(.Rows.Count, ITR(0)).End(xlUp)).Value2, "CODES"
        Query.Add .Range(ITR(1) & "2", ITR(1) & .UsedRange.Rows.Count), "DESTINATION RANGE"
       
        Query.Add output, "OUTPUT"

        Comparison_CLCTN.Remove Z
        Comparison_CLCTN.Add Query
       
    Next Z
   
End With

Const delimiter As String = ", "

With Comparison_CLCTN

    For X = LBound(input_data, 1) To UBound(input_data, 1) 'Loop each ROW of columns J through L
   
        row_str = vbNullString
       
        For Y = LBound(input_data, 2) To UBound(input_data, 2) 'Loop each COLUMN from J to L and generate a string to be searched
            
            On Error GoTo String_Concatenation_Error
            
            If Not input_data(X, Y) = Empty Then
                row_str = row_str & "|" & input_data(X, Y)
            End If
            
        Next Y
       
        If Not row_str = vbNullString Then
       
            For T = 1 To .Count 'Loop Comparison_CLCTN
           
                With .Item(T) 'With given values of (codes,destination ranges,etc)
                   
                    harness_numbers = .Item("CODES")
                    output = .Item("OUTPUT")
                   
                    For Z = LBound(harness_numbers, 1) To UBound(harness_numbers, 1) 'Loop though each Harness Number from column Y
                        'patterns:
                        'Any string + code + any non-alphanumeric character + Any string(includes empty string)
                        'Any string + code
                       
                        If Not harness_numbers(Z, 1) = Empty _
                        And (row_str Like "*" & harness_numbers(Z, 1) & "[!A-Za-z0-9]*" _
                            Or row_str Like "*" & harness_numbers(Z, 1)) Then
                           
                            output(X, 1) = output(X, 1) & IIf(output(X, 1) = Empty, vbNullString, delimiter) & harness_numbers(Z, 1)

                        End If
                       
                    Next Z
                    
                    If Not output(X, 1) = Empty Then 'If pattern matches were found
                        .Remove "OUTPUT"
                        .Add output, "OUTPUT"
                    End If
                   
                End With
               
            Next T
            Erase harness_numbers
            Erase output
        End If
       
        If X Mod 3000 = 0 Then DoEvents 'Allow user interaction with Excel every 3000 loops
       
    Next X

End With

With ThisWorkbook.ActiveSheet
    For Each ITR In Comparison_CLCTN
        ITR("DESTINATION RANGE").Value2 = ITR("OUTPUT")
    Next ITR
End With

MsgBox "Search Completed."

Exit Sub

String_Concatenation_Error:
    MsgBox "An error occured on row " & X & vbNewLine & vbNewLine & _
    "Description: " & Err.Description & vbNewLine & vbNewLine & _
    "Added Value: " & input_data(X, Y) & "Type: " & TypeName(input_data(X, Y))
    
End Sub

plk0507 · Dec 16, 2021

MoshiM said:

Interesting try this and reply with the contents of the message it shows you.

VBA Code:

Sub Harness_Search()

'=TEXTJOIN(", ", TRUE, IF( COUNTIF(J2:L2, "*"&$Y$2:$Y$9&"*"), $Y$2:$Y$9, ""))
Dim input_data() As Variant, X As Long, Y As Long, output() As String, ITR As Variant, T As Long, _
harness_numbers() As Variant, Z As Long, value() As String, Comparison_CLCTN As New Collection, Query As Collection, row_str As String

With ThisWorkbook.ActiveSheet

    input_data = .Range("J2", "L" & .UsedRange.Rows.Count).Value2 'Data from columns J through L
  
    ReDim output(LBound(input_data, 1) To UBound(input_data, 1), 1 To 1)
  
    Comparison_CLCTN.Add Array("Y", "M") 'Source of codes followed by output column
    Comparison_CLCTN.Add Array("Z", "N") 'Source of codes followed by output column
  
    For Z = Comparison_CLCTN.Count To 1 Step -1
  
        ITR = Comparison_CLCTN(Z)
      
        Set Query = New Collection
       
        Debug.Print .Range(ITR(0) & "2", .Cells(.Rows.Count, ITR(0)).End(xlUp)).Address
       
        Query.Add .Range(ITR(0) & "2", .Cells(.Rows.Count, ITR(0)).End(xlUp)).Value2, "CODES"
        Query.Add .Range(ITR(1) & "2", ITR(1) & .UsedRange.Rows.Count), "DESTINATION RANGE"
      
        Query.Add output, "OUTPUT"

        Comparison_CLCTN.Remove Z
        Comparison_CLCTN.Add Query
      
    Next Z
  
End With

Const delimiter As String = ", "

With Comparison_CLCTN

    For X = LBound(input_data, 1) To UBound(input_data, 1) 'Loop each ROW of columns J through L
  
        row_str = vbNullString
      
        For Y = LBound(input_data, 2) To UBound(input_data, 2) 'Loop each COLUMN from J to L and generate a string to be searched
           
            On Error GoTo String_Concatenation_Error
           
            If Not input_data(X, Y) = Empty Then
                row_str = row_str & "|" & input_data(X, Y)
            End If
           
        Next Y
      
        If Not row_str = vbNullString Then
      
            For T = 1 To .Count 'Loop Comparison_CLCTN
          
                With .Item(T) 'With given values of (codes,destination ranges,etc)
                  
                    harness_numbers = .Item("CODES")
                    output = .Item("OUTPUT")
                  
                    For Z = LBound(harness_numbers, 1) To UBound(harness_numbers, 1) 'Loop though each Harness Number from column Y
                        'patterns:
                        'Any string + code + any non-alphanumeric character + Any string(includes empty string)
                        'Any string + code
                      
                        If Not harness_numbers(Z, 1) = Empty _
                        And (row_str Like "*" & harness_numbers(Z, 1) & "[!A-Za-z0-9]*" _
                            Or row_str Like "*" & harness_numbers(Z, 1)) Then
                          
                            output(X, 1) = output(X, 1) & IIf(output(X, 1) = Empty, vbNullString, delimiter) & harness_numbers(Z, 1)

                        End If
                      
                    Next Z
                   
                    If Not output(X, 1) = Empty Then 'If pattern matches were found
                        .Remove "OUTPUT"
                        .Add output, "OUTPUT"
                    End If
                  
                End With
              
            Next T
            Erase harness_numbers
            Erase output
        End If
      
        If X Mod 3000 = 0 Then DoEvents 'Allow user interaction with Excel every 3000 loops
      
    Next X

End With

With ThisWorkbook.ActiveSheet
    For Each ITR In Comparison_CLCTN
        ITR("DESTINATION RANGE").Value2 = ITR("OUTPUT")
    Next ITR
End With

MsgBox "Search Completed."

Exit Sub

String_Concatenation_Error:
    MsgBox "An error occured on row " & X & vbNewLine & vbNewLine & _
    "Description: " & Err.Description & vbNewLine & vbNewLine & _
    "Added Value: " & input_data(X, Y) & "Type: " & TypeName(input_data(X, Y))
   
End Sub

Same error. This time, these lines are highlighted when I click debug:
MsgBox "An error occured on row " & X & vbNewLine & vbNewLine & _
"Description: " & Err.Description & vbNewLine & vbNewLine & _
"Added Value: " & input_data(X, Y) & "Type: " & TypeName(input_data(X, Y))

plk0507 · Dec 16, 2021

plk0507 said:
Same error. This time, these lines are highlighted when I click debug:
MsgBox "An error occured on row " & X & vbNewLine & vbNewLine & _
"Description: " & Err.Description & vbNewLine & vbNewLine & _
"Added Value: " & input_data(X, Y) & "Type: " & TypeName(input_data(X, Y))

Also, does having that textjoin formula at the top matter?

MoshiM · Dec 16, 2021

plk0507 said:
Also, does having that textjoin formula at the top matter?

remove "Added Value: " & input_data(X, Y) & from the string at the bottom and no it was just a reference for me while I was coding. It can be delteted

Akuini · Dec 16, 2021

@plk0507
Did you try my code at post #14?

plk0507 · Dec 16, 2021

MoshiM said:
remove "Added Value: " & input_data(X, Y) & from the string at the bottom and no it was just a reference for me while I was coding. It can be delteted

I get the following error, "An error occurred on row 5660 Description: Type Mismatch Type: Error"
I don't see anything special about line 5660.
So we're on the same page, this is what those three lines look like now:
MsgBox "An error occured on row " & X & vbNewLine & vbNewLine & _
"Description: " & Err.Description & vbNewLine & vbNewLine & _
"Type: " & TypeName(input_data(X, Y))

plk0507 · Dec 16, 2021

Akuini said:
@plk0507
Did you try my code at post #14?

Not yet, but I promise I will. I'm trying to squeeze this project in between meetings at work.

Thank you so much!

VBA Solution to Search Text and Return Desired Result

plk0507

New Member

plk0507

New Member

Excel Facts

MoshiM

Active Member

plk0507

New Member

MoshiM

Active Member

plk0507

New Member

plk0507

New Member

MoshiM

Active Member

Akuini

Well-known Member

plk0507

New Member

plk0507

New Member

Similar threads

Forum statistics

Share this page

VBA Solution to Search Text and Return Desired Result

New Member

New Member

Excel Facts

Active Member

New Member

Active Member

New Member

New Member

Active Member

Well-known Member

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock