Problem with line (row) in a macro
Hello friends, I wrote in two forums but second week no one can help me with my problem and just one line in the macro. There is something that needs to change for things to happen but I do not know what and how to change it. I would be very grateful if you assist me by your side.
Thanks to colleague (who helped me a lot and I am grateful to him) make a macro that I do a great job, but I have a problem I can not handle.
With this macro search from a database of all matching words and returns the result in the selected column and adds matches with plus sign (+) -> word1+word2+word3.......... or result = ?
But there's a problem, because if the words are too similar macro I added each match and shows wrong result.
QUIN200 -> RESULT=10, QUIN200PR -> result=15
sim20 -> RESULT=8, sim10 -> result=5
If I'm looking for word such as: (QUIN200) and (SIM20)
And in the database have close similar words
QUIN200
QUIN200PR
SIM20
SIM10
....
ect
I've selected column and the appropriate box should I return this result: 10+8
But now I return a result that is wrong, because obviously evidence from macro should I order something to change: 10+15+8+5
Code:
Sub Terapia()
Dim X As Long, Cell As Range, CellText As String, ws As Worksheet
Dim Words As Variant, Replacements As Variant
Const TableSheetName As String = "Sheet1"
Application.Volatile
Words = Sheets(TableSheetName).Range("AH2", Sheets(TableSheetName).Cells(Rows.Count, "AH").End(xlUp))
Replacements = Sheets(TableSheetName).Range("AI2", Sheets(TableSheetName).Cells(Rows.Count, "AI").End(xlUp))
For Each ws In Worksheets
For Each Cell In ws.Range("J2", ws.Cells(Rows.Count, "J").End(xlUp))
CellText = ""
For X = 1 To UBound(Words)
If InStr(1, Cell.Value, Words(X, 1), vbTextCompare) Then CellText = CellText & "+" & Replacements(X, 1) ' Here is my problem
Next
Cell.Offset(, 4).Value = Mid(CellText, 2)
Next
Next
End Sub
Again with the assistance of a colleague changed this line in the macro:
Code:
If InStr(1, Cell.Value, Words(X, 1), vbTextCompare) Then CellText = CellText & "+" & Replacements(X, 1)
with this:
Code:
If Cell.Value = Words(X, 1) Then CellText = CellText & "+" & Replacements(X, 1)
but now I have another problem (with this modified line) is exactly what I'm looking for, but if a row has more than one word, I do not add the next (or the result).
attach an image to grasp the idea:
Link image
