I have been going mad for the past few hours. Have a search code that aims to compare a range of cells to a particular search string.
I have validated that it searches at least 1 cell for substring matches but get stuck trying to print my answer to a cell. Simple as that. I know the column and row that I want to print to, I know the string that I want to put there but I keep getting 1004 and 424 errors. I have no problem reading a range.value, but assigning one is a different story. VBA is good when it works but I'm not a fan today. Any help would be wonderful. Code follows:
'Arguments: srch is string to be found, colRng is a column range, minMatch is min number of characters for match
'Advise to use srch in right most column in the spreadsheet. Adjacent cells to the right will be populated with
' possible matches to the srch string in the colRng range
Public Function findStr(srch As String, ColRng As Range, minMatch As Integer)
Dim writeRng As Range
MsgBox ActiveCell.Address
printrow = ActiveCell.Row
printcol = ActiveCell.Column + 1 'WARNING!!!! Will overwrite cells adjacent to search
printcolLetter = Split(Cells(1, ActiveCell.Column).Address, "$")(1)
For Each cell In ColRng
x = cell.Value
cellLen = Len(x)
cellRow = cell.Row
For srchLen = cellLen To minMatch Step -1 'check for complete matches and down to matches with minMatch Characters
startChar = 1 'reset start character in search
While startChar + srchLen - 1 <= cellLen
strsch = Mid(x, startChar, srchLen) ' current substring of current cell to compare
'MsgBox ("StartChar: " & startChar & " srchLen:" & srchLen & strsch & " StringCompare:" & StrComp(strsch, srch, vbBinaryCompare))
If StrComp(strsch, srch, vbBinaryCompare) = 0 Then 'returning 0 indicates possible match
Worksheets(1).Activate
Set writeRng = Range(Cells(printrow, printcol), Cells(printrow, printcol))
Call writeRange(writeRng, x)
'Cells(printrow, printcol).Select
printcol = printcol + 1 'increment for next possible result
startChar = cellLen + 1 'flag end of while loop as printed matched output for this cell
End If
startChar = startChar + 1
Wend
Next srchLen
Next cell
End Function
Public Sub writeRange(rng As Range, txt)
rng.Value = txt
End Sub