Macro needed to append data to cell in selected column with input string
Budget: $2 – $3 USD
I can pay $2 for the first working solution that I test.
'If the row contains "a specific string" of characters then that specific string of characters should be appended to the end of the cell in the currently selected column.
'This should occur only if the cell in the selected column for the row in question does not already contain that string of characters.
'Also, if the specific string of characters is not found anywhere on the row, then it should not be appended.
I have also included the sample sheet with the macro included.
When I tried to run it, I got this error.
When I tried the code, I got this error https://www.screencast.com/t/mgFtwhXdff
So it needs to be modified to accomplish my objective.
[code]
Option Explicit
Sub findAndAppend()
Dim tcell As Range
Dim lookFor As String, firstaddress
Dim fnd As Range ' union of all found cells
lookFor = "craig" ' InputBox("What to find")
If lookFor = "" Then Exit Sub
' \\\\\\\\\\\\\\\ BEGIN "Standard Find All" code finds ALMOST ALL occurances \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
With ActiveSheet.Cells
Set tcell = .Find(What:=lookFor, LookIn:=xlValues, LookAt:=xlPart, _
MatchCase:=False, searchOrder:=xlByRows)
If tcell Is Nothing Then
MsgBox "not found"
Exit Sub
End If
If Not tcell Is Nothing Then
firstaddress = tcell.Address
Do
Dim addit As Boolean ' under some weird circumstances the loop can hit the same cell more than once.
If fnd Is Nothing Then
Set fnd = tcell
addit = True
ElseIf Intersect(fnd, tcell) Is Nothing Then
Set fnd = Union(fnd, tcell)
addit = True
Else
addit = False
End If
If tcell.Row = 13 Then Stop
If addit Then
If tcell.Column > 1 Then
With tcell.EntireRow.Cells(1)
If InStr(1, .Value, tcell, 1) = 0 Then
.Value = .Value & " " & tcell
End If
End With
End If
End If
Set tcell = .FindNext(tcell)
Loop While tcell.Address <> firstaddress
End If
End With
' /////////////// END "STANDARD FIND ALL CODE" ///////////////////////////////////////////////////////////
MsgBox "done"
End Sub
[/code]
'If the row contains "a specific string" of characters then that specific string of characters should be appended to the end of the cell in the currently selected column.
'This should occur only if the cell in the selected column for the row in question does not already contain that string of characters.
'Also, if the specific string of characters is not found anywhere on the row, then it should not be appended.
I have also included the sample sheet with the macro included.
When I tried to run it, I got this error.
When I tried the code, I got this error https://www.screencast.com/t/mgFtwhXdff
So it needs to be modified to accomplish my objective.
[code]
Option Explicit
Sub findAndAppend()
Dim tcell As Range
Dim lookFor As String, firstaddress
Dim fnd As Range ' union of all found cells
lookFor = "craig" ' InputBox("What to find")
If lookFor = "" Then Exit Sub
' \\\\\\\\\\\\\\\ BEGIN "Standard Find All" code finds ALMOST ALL occurances \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
With ActiveSheet.Cells
Set tcell = .Find(What:=lookFor, LookIn:=xlValues, LookAt:=xlPart, _
MatchCase:=False, searchOrder:=xlByRows)
If tcell Is Nothing Then
MsgBox "not found"
Exit Sub
End If
If Not tcell Is Nothing Then
firstaddress = tcell.Address
Do
Dim addit As Boolean ' under some weird circumstances the loop can hit the same cell more than once.
If fnd Is Nothing Then
Set fnd = tcell
addit = True
ElseIf Intersect(fnd, tcell) Is Nothing Then
Set fnd = Union(fnd, tcell)
addit = True
Else
addit = False
End If
If tcell.Row = 13 Then Stop
If addit Then
If tcell.Column > 1 Then
With tcell.EntireRow.Cells(1)
If InStr(1, .Value, tcell, 1) = 0 Then
.Value = .Value & " " & tcell
End If
End With
End If
End If
Set tcell = .FindNext(tcell)
Loop While tcell.Address <> firstaddress
End If
End With
' /////////////// END "STANDARD FIND ALL CODE" ///////////////////////////////////////////////////////////
MsgBox "done"
End Sub
[/code]