vba - Substitute text Data from two different columns

Question

I want to remove single word from multiple words separated by comma:

I Want a macro that should work for all sheets in workbook.

I have the following data in Column A in Sheet1, Sheet2, Sheet3. The no of rows and data differ for different sheets.

Little Nicobar
Mildera
Mus
Nancowrie
Nehrugram
Pilomilo Island

and Following data in Column Q:

Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island

Want output in Column R as follows:

Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram

Means i want remove word in column A from Column R.

For this we can use the formula in R1

=TRIM(SUBSTITUTE(Q1,A1,""))

But its only working for R1.

I want a macro that provides the desired output and should work for all sheets. As the different data present in Sheet1, sheet2...sheetn. Help me.

Answer 1

Try this

Sub test()
    Dim vDB, vData, vR()
    Dim s As String
    Dim Ws As Worksheet
    Dim i As Long, n As Long
    For Each Ws In Worksheets
        With Ws
            vDB = .Range("a1", .Range("a" & Rows.Count).End(xlUp))
            n = UBound(vDB, 1)
            vData = .Range("q1").Resize(n)
            ReDim vR(1 To n, 1 To 1)
            For i = 1 To n
                s = Replace(vData(i, 1), vDB(i, 1), "")
                s = Replace(s, ",,", ",")
                If Left(s, 1) = "," Then
                    Mid(s, 1, 1) = Space(1)
                End If
                If Right(s, 1) = "," Then
                    Mid(s, Len(s), 1) = Space(1)
                End If
                vR(i, 1) = Trim(s)
            Next i
            .Range("r1").Resize(n) = vR
        End With
    Next Ws
End Sub