Match and delete

[topi1]

Need help with VBA. TY.

In the following example, I want the vba to loop through all column R cells where the column Q value is 9. Match the strings in those cells and see if they contain any of the strings in the column U. case insensitive match is fine. If the cell in the column R with column Q=9 does not contain any of the column U strings, delete it. Thank you. If the code works, last two cells should be deleted.

Book1
	Q	R	S	T	U
1		Theater:			delim1.
2		Movie:			delim2.
3					delim3.
4					delim4.
5		TITLE1			delim5.
6					delim6.
7	4	Eros: Dunn			delim7.
8	4	Strand shows Abba.			delim8.
9	4	Regal: Superman			delim9.
10	4	Roxi shows Cars.			delim10.
11	4	Metro: Batman
12	4	Minerva: Starwars
13
14
15
16	5	Eros shows Superman nextweek.
17	5	Metro shows Dunn next month.
18	5
19		TITLE2
20	9	Eros shows Superman nextweek. Delim4.
21	9	Metro shows Dunn next month. Delim3. Closed today.
22	9	Delim2. Minerva is showing Abba.
23	9	Before Metro Roxi shows Cars.
24	9	After Eros Strand shows Abba.
Sheet2

 

[Cubist]

What's the data set your running the code on that gives the error?

 

[topi1]

Here it is. Thank you much. I do have idenitcal column U insheet1 too.

Book1
	O	P	Q	R	S	T	U
1				Theater:			delim1.
2				Movie:			delim2.
3				TITLE1			delim3.
4	Eros	Eros:	4	Eros: Dunn			delim4.
5	Eros			Strand shows Abba.			delim5.
6	Eros			Mandir shows Sholay			delim6.
7	Metro			Roxi shows Cars.			delim7.
8	Metro			Opera House shows Shor			delim8.
9	Metro	Metro:	4	Metro: Batman			delim9.
10	Minerva	Minerva:	4	Minerva: Starwars			delim10.
11	Regal	Regal:	4	Regal: Superman
12			5	Eros shows Superman nextweek.
13			5	Metro shows Dunn next month.
14	Metro	Place		TITLE2
15			9	Eros shows Superman nextweek. Delim4.
16			9	Metro shows Dunn next month. Delim3. Closed today.
17			9	Delim2. Minerva is showing Abba.
18			9	Before Metro Roxi shows Cars.
19			9	After Eros Strand shows Abba.
20			9	After Eros Mandir shows Sholay
21			9	Before Metro Opera House shows Shor
Sheet2

 

[Cubist]

I can't replicate the error. It runs fine on my end. What is on Sheet1?

 

[topi1]

Book1
	U
1	delim1.
2	delim2.
3	delim3.
4	delim4.
5	delim5.
6	delim6.
7	delim7.
8	delim8.
9	delim9.
10	delim10.
Sheet1

 

[Cubist]

I don't see anything that would cause the Subscript error. Try running it on a new blank workbook.

 

[topi1]

ok. TY.

 

[topi1]

It did much better in the new book. However, it did not sort based on the order in the column U.

 

[topi1]

Here is what I mean. I got the following results.

Book1
	O	P	Q	R	S	T	U
1				Theater:			delim1.
2				Movie:			delim2.
3				TITLE1			delim3.
4	Eros	Eros:	4	Eros: Dunn			delim4.
5	Eros			Strand shows Abba.			delim5.
6	Eros			Mandir shows Sholay			delim6.
7	Metro			Roxi shows Cars.			delim7.
8	Metro			Opera House shows Shor			delim8.
9	Metro	Metro:	4	Metro: Batman			delim9.
10	Minerva	Minerva:	4	Minerva: Starwars			delim10.
11	Regal	Regal:	4	Regal: Superman
12			5	Eros shows Superman nextweek.
13			5	Metro shows Dunn next month.
14	Metro	Place		TITLE2
15			9	Eros shows Superman nextweek.
16			9	Metro shows Dunn next month. Closed today.
17			9	Minerva is showing Abba.
Sheet2

Based on the the delim value the last three rows had, It should have been the following.

Book1
	O	P	Q	R	S	T	U
1				Theater:			delim1.
2				Movie:			delim2.
3				TITLE1			delim3.
4	Eros	Eros:	4	Eros: Dunn			delim4.
5	Eros			Strand shows Abba.			delim5.
6	Eros			Mandir shows Sholay			delim6.
7	Metro			Roxi shows Cars.			delim7.
8	Metro			Opera House shows Shor			delim8.
9	Metro	Metro:	4	Metro: Batman			delim9.
10	Minerva	Minerva:	4	Minerva: Starwars			delim10.
11	Regal	Regal:	4	Regal: Superman
12			5	Eros shows Superman nextweek.
13			5	Metro shows Dunn next month.
14	Metro	Place		TITLE2
15			9	Minerva is showing Abba.
16			9	Metro shows Dunn next month. Closed today.
17			9	Eros shows Superman nextweek.
Sheet2

 

[topi1]

The original data was as follows.

Book1
	Y	Z
1	9	Eros shows Superman nextweek. Delim4.
2	9	Metro shows Dunn next month. Delim3. Closed today.
3	9	Delim2. Minerva is showing Abba.
Sheet2

 

[Cubist]

Try.

Sub CheckAndClear()
    Dim ws As Worksheet, ws2 As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long, k As Long
    Dim dataQ As Variant, dataR As Variant, dataU As Variant
    Dim foundRow As Long
    Dim foundWords() As String

    Set ws = ThisWorkbook.Sheets("Sheet2") 'Main sheet
    Set ws2 = ThisWorkbook.Sheets("Sheet1") 'Delim sheet

    lastRow = ws.Cells(ws.Rows.Count, "Q").End(xlUp).Row

    dataQ = ws.Range("Q1:Q" & lastRow).Value
    dataR = ws.Range("R1:R" & lastRow).Value
    dataU = ws2.Range("U1:U" & ws2.Cells(ws2.Rows.Count, "U").End(xlUp).Row).Value

    foundRow = 1
    foundIndex = 1
    ReDim foundWords(1 To UBound(dataR, 1), 1 To 1)

    ' Iterate over dataU array first
    For j = 1 To UBound(dataU, 1)
        For i = 1 To UBound(dataQ, 1)
            If dataQ(i, 1) = 9 Then
                If foundRow = 1 Then foundRow = i ' Store the first row 9
                If InStr(1, dataR(i, 1), dataU(j, 1), vbTextCompare) > 0 Then
                    foundWords(foundIndex, 1) = dataR(i, 1)
                    Debug.Print dataR(i, 1)
                    Debug.Print foundWords(foundIndex, 1)
                    For k = LBound(dataU) To UBound(dataU)
                        foundWords(foundIndex, 1) = Trim(Replace(foundWords(foundIndex, 1), dataU(k, 1), "", , , vbTextCompare))
                    Next k
                    foundIndex = foundIndex + 1
                End If
            End If
        Next i
    Next j

    If foundRow > 1 Then
        ws.Range("R" & foundRow).Resize(UBound(foundWords, 1), 1).Value = foundWords
    End If

    For i = lastRow To 1 Step -1
        If ws.Cells(i, "R").Value = "" Then
            ws.Rows(i).Delete
        End If
    Next i
End Sub