Search column for string and write to cell

[Blee]

Not sure why I cannot find any code to do this, but.... I'm looking to
write a macro that would search a specific column for a string
(contains) and write a specific value to another cell in that same row
if there is a match. I.e., If column Z has a string that contains
"zebra", write "animal" to cell B of that same row. Anyone?

 

[Tom Hutchins]

One example...

Paste this code in a VBA module in your workbook. Click any cell in the
column to be searched, then run the macro (Tools >> Macro >> Macros >>
FindText >> Run).

Sub FindText()
Dim c As Range, ret
Const FindThis = "zebra"
Const WriteThis = "animal"
ActiveCell.EntireColumn.Select
For Each c In Selection
ret = InStr(c, FindThis)
If (Not IsNull(ret)) And (ret > 0) Then
c.Offset(0, 1).Value = WriteThis
End If
Next c
End Sub

Hope this helps,

Hutch

 

[Blee]

Thank you, Tom. Very interesting. And I can control which cell is
written to by using the Offset +/- values. Any way to actually specify
the cell by column letter?

 

[Blee]

Thank you, Tom. Very interesting. And I can control which cell is
written to by using the Offset +/- values. Any way to actually specify
the cell by column letter?

Also, is there a flag for case insensitive searches?

 

[Blee]

Also, is there a flag for case insensitive searches?

ret = InStr(1, c, FindThis, vbTextCompare)

 

[Tom Hutchins]

Here are two more versions of the same subroutine. The first does a
case-sensitive search, and both the column to search and the column to which
to write are specified as constants. The second version prompts the user for
everything.

Sub FindText1()
Dim c As Range, ret
Const FindThis = "zebra"
Const WriteThis = "animal"
Const SearchCol = "A"
Const WriteCol = "B"
Range(SearchCol & "1").EntireColumn.Select
For Each c In Selection
ret = InStr(1, c, FindThis, 0)
If (Not IsNull(ret)) And (ret > 0) Then
Range(WriteCol & c.Row).Value = WriteThis
End If
Next c
End Sub

Sub FindText2()
Dim c As Range, FindThis As String, CaseSens As Integer
Dim WriteThis As String, SearchCol As String
Dim WriteCol As String, ret
FindThis = InputBox("Text to find", "FindText2", "zebra")
If Len(FindThis) = 0 Then Exit Sub
WriteThis = InputBox("Text to write", "FindText2", "animal")
If Len(WriteThis) = 0 Then Exit Sub
SearchCol = InputBox("Search which column?", "FindText2", "A")
If Len(SearchCol) = 0 Then Exit Sub
WriteCol = InputBox("Write to which column?", "FindText2", "B")
If Len(WriteCol) = 0 Then Exit Sub
ret = MsgBox("Case-sensitive?", vbYesNo, "FindText2")
If ret = vbYes Then
CaseSens = 0
Else
CaseSens = 1
End If
Range(SearchCol & "1").EntireColumn.Select
For Each c In Selection
ret = InStr(1, c, FindThis, CaseSens)
If (Not IsNull(ret)) And (ret > 0) Then
Range(WriteCol & c.Row).Value = WriteThis
End If
Next c
End Sub

Hope this helps,

Hutch