Substitute text Data from two different columns - vba

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

Answer 2

Write this formula in R1 and drag down
=SUBSTITUTE(Q1,","&A1,"")

Answer 3

I feel like this is definitely possible with excel functions as VB seems like overkill. This puts your large string in col Q into an array and removes whatever the value in col A is. See my answer below and let me know if you have any issues. This is also assuming your data doesn't have headers.
Sub ReplaceThings()
Dim wbk As Workbook
Dim wksht As Worksheet
Dim RemoveMe As String, myList() As String, myText As String
Dim Cell As Range
Dim x As Long, lRow As Long, p As Long
Set wbk = Workbooks("StackOverflow.xlsm") 'Change this to your workbook name
'Loop through each worksheet in workbook
For Each wksht In wbk.Worksheets
With wksht
'Find last row
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
For Each Cell In .Range("A1:A" & lRow)
RemoveMe = Cell.Value
'Fill array with data in Column Q
myList = Split(Cell.Offset(0, 16).Value, ",")
For x = LBound(myList) To UBound(myList)
'Loop through array and check if RemoveMe is in Array
If myList(x) = RemoveMe Then
'Remove value from array
For p = x To UBound(myList) - 1
myList(p) = myList(p + 1)
Next p
Exit For
End If
Next x
'Print value to column Q
For x = LBound(myList) To UBound(myList)
If x = 0 Then
myText = myText & myList(x)
Else
myText = myText & "," & myList(x)
End If
Next x
Cell.Offset(0, 17) = myText
myText = ""
Erase myList
Next Cell
End With
Next wksht
End Sub