VBA Solution to Search Text and Return Desired Result

[plk0507]

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.	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	***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	44181	44.3	HILL AFB UT	1	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	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	44179	6	HILL AFB UT	1	1	42				W1844
5	F016D	8900002166	150567407	2	64000	799	X	D	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	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	1	40				W1812
7	F016D	8800000170	210670228	14	69B98	308	R	B	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	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	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	***ADD TIME REQ, REF OP#91427*** NSFE WIRE HARNESS 16DW2690-501 FOUND UNINSTALLED. T.O./FIG:IAW 16D40730	W269, W2690		44181	44181	2.1	HILL AFB UT	1	6	42				W2682
10	F016D	9000000783	203490429	0	69000	800	S	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	NSFE WIRE HARNESS 16DW2690-501 FOUND UNINSTALLED. T.O./FIG:IAW 16D40730	W269, W2690		44179	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	1	42
Sheet2

 

[MoshiM]

This ought to do it. I also converted some of the collection use to arrays.

Sub Harness_Search()

Dim input_data() As Variant, X As Long, Y As Long, output() As String, ITR As Variant, T As Long, _
Z As Long, value() As String, Query() As Variant, row_str As String, Query_CLCTN As New Collection

    Dim Destination_RNG As Range
 
    Const delimiter 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)
   
        Query_CLCTN.Add Array("Y", "M") '(Source of codes, output column)
        Query_CLCTN.Add Array("Z", "N")
   
        ReDim Query(1 To Query_CLCTN.Count)
   
        For Z = LBound(Query) To UBound(Query)
  
            ITR = Query_CLCTN(Z)
       
            harness_codes = .Range(ITR(0) & "2", .Cells(.Rows.Count, ITR(0)).End(xlUp)).Value2
            Set Destination_RNG = .Range(ITR(1) & "2", ITR(1) & .UsedRange.Rows.Count)
       
            Query(Z) = Array(harness_codes, Destination_RNG, output)
      
        Next Z
  
    End With
 
    Set Destination_RNG = Nothing
    Set Query_CLCTN = Nothing
    Erase harness_codes
 
    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
        On error goto 0
        If Not row_str = vbNullString Then
  
            For T = LBound(Query) To UBound(Query) 'Loop Query
               
                 'Query(T)(0) are the codes being searched for
                 For Z = LBound(Query(T)(0), 1) To UBound(Query(T)(0), 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 Query(T)(0)(Z, 1) = Empty _
                     And (row_str Like "*" & Query(T)(0)(Z, 1) & "[!A-Za-z0-9]*" _
                         Or row_str Like "*" & Query(T)(0)(Z, 1)) Then
                   
                         Query(T)(2)(X, 1) = Query(T)(2)(X, 1) & IIf(Query(T)(2)(X, 1) = Empty, vbNullString, delimiter) & Query(T)(0)(Z, 1)

                     End If
               
                 Next Z
          
            Next T

        End If
  
        If X Mod 3000 = 0 Then DoEvents 'Allow user interaction with Excel every 3000 loops
  
    Next X

With ThisWorkbook.ActiveSheet
    For Each ITR In Query
        ITR(1).Value2 = ITR(2)
    Next ITR
End With

MsgBox "Search Completed."

Exit Sub

String_Concatenation_Error:
 
    If iserror( input_data(X, Y))  Then
        Resume Next
    Else
        MsgBox "An error occured on row " & X + 1 & vbNewLine & vbNewLine & _
        "Description: " & Err.Description & vbNewLine & vbNewLine & _
        "Type: " & TypeName(input_data(X, Y))
    End If
 
End Sub

 

[plk0507]

This ought to do it. I also converted some of the collection use to arrays.

Sub Harness_Search()

Dim input_data() As Variant, X As Long, Y As Long, output() As String, ITR As Variant, T As Long, _
Z As Long, value() As String, Query() As Variant, row_str As String, Query_CLCTN As New Collection

    Dim Destination_RNG As Range
 
    Const delimiter 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)
  
        Query_CLCTN.Add Array("Y", "M") '(Source of codes, output column)
        Query_CLCTN.Add Array("Z", "N")
  
        ReDim Query(1 To Query_CLCTN.Count)
  
        For Z = LBound(Query) To UBound(Query)
 
            ITR = Query_CLCTN(Z)
      
            harness_codes = .Range(ITR(0) & "2", .Cells(.Rows.Count, ITR(0)).End(xlUp)).Value2
            Set Destination_RNG = .Range(ITR(1) & "2", ITR(1) & .UsedRange.Rows.Count)
      
            Query(Z) = Array(harness_codes, Destination_RNG, output)
     
        Next Z
 
    End With
 
    Set Destination_RNG = Nothing
    Set Query_CLCTN = Nothing
    Erase harness_codes
 
    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
        On error goto 0
        If Not row_str = vbNullString Then
 
            For T = LBound(Query) To UBound(Query) 'Loop Query
              
                 'Query(T)(0) are the codes being searched for
                 For Z = LBound(Query(T)(0), 1) To UBound(Query(T)(0), 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 Query(T)(0)(Z, 1) = Empty _
                     And (row_str Like "*" & Query(T)(0)(Z, 1) & "[!A-Za-z0-9]*" _
                         Or row_str Like "*" & Query(T)(0)(Z, 1)) Then
                  
                         Query(T)(2)(X, 1) = Query(T)(2)(X, 1) & IIf(Query(T)(2)(X, 1) = Empty, vbNullString, delimiter) & Query(T)(0)(Z, 1)

                     End If
              
                 Next Z
         
            Next T

        End If
 
        If X Mod 3000 = 0 Then DoEvents 'Allow user interaction with Excel every 3000 loops
 
    Next X

With ThisWorkbook.ActiveSheet
    For Each ITR In Query
        ITR(1).Value2 = ITR(2)
    Next ITR
End With

MsgBox "Search Completed."

Exit Sub

String_Concatenation_Error:
 
    If iserror( input_data(X, Y))  Then
        Resume Next
    Else
        MsgBox "An error occured on row " & X + 1 & vbNewLine & vbNewLine & _
        "Description: " & Err.Description & vbNewLine & vbNewLine & _
        "Type: " & TypeName(input_data(X, Y))
    End If
 
End Sub

When I put that into VBA, there isn't a macro to run.

 

[MoshiM]

When I put that into VBA, there isn't a macro to run.

Ensure that

If iserror( input_data(X, Y))  Then

is the first line in the error handler at the bottom. I did an edit shortly after posting. If it still doesn't work then try Debug>Compile and tell me if something is wrong

 

[plk0507]

Ensure that

If iserror( input_data(X, Y))  Then

is the first line in the error handler at the bottom. I did an edit shortly after posting. If it still doesn't work then try Debug>Compile and tell me if something is wrong

Holy cow, it worked! I'm going to try and duplicate it on a couple of other files this afternoon and I'll let you know.

 

[plk0507]

MoshiM - Thank you. I appreciate your efforts to help me solve this problem. I'm jealous of your ability to write code; that's super cool.

Akuini - Thank you as well...I see MoshiM used something from your code to solve a problem. And I'm going to try your solution as well and let you know how it goes.