Function to loop through a column and return a value based on an x

[DoctorV]

See the below code. What we want to do is instead of using VBA to use
formula (Join & Trim) if possible. Don't want to have an input box
just named ranges, loop through named range "A" for and cell
containing x and if x then place results from named range "B" into on
cell Concatenating and commas separating each result.

Anybody help? Thanks!

Sub JoinCells()
Dim rCells As Range
Dim rRange As Range
Dim rStart As Range
Dim strStart As String
Dim iReply As Integer
On Error Resume Next

'Change Below to a named range instead of an input box

Set rCells = Application.InputBox _
(Prompt:="Select the cells to join," _
& "use Ctrl for non-contiguous cells.", _
Title:="CONCATENATION OF CELLS", Type:=8)

If rCells Is Nothing Then 'Cancelled or mistake
iReply = MsgBox("Invalid selection!", _
vbQuestion + vbRetryCancel)
If iReply = vbCancel Then
On Error GoTo 0
Exit Sub
Else
Run "JoinCells" 'Try again
End If
End If

'Set range variable to first cell
Set rStart = rCells(1, 1)

'Loop through cells chosen
For Each rRange In rCells
strStart = rRange 'parse cell content to a String
rRange.Clear 'Clear contents of cell
'Replace the original contents of first cell with "", then _
join the text Need to put results in a specific cell address
rStart = Trim(Replace(rStart, rStart, "") & " " _
& rStart & " " & strStart)
Next rRange
On Error GoTo 0

End Sub

Debbie Worst
Small Applications Team
513.345.6462

-----Original Message-----
From: Vessey, David
Sent: Thursday, July 08, 2004 8:27 AM
To: Worst, Debbie
Subject: Code for Looping

Sub JoinCells()
Dim rCells As Range
Dim rRange As Range
Dim rStart As Range
Dim strStart As String
Dim iReply As Integer
On Error Resume Next

'Allow user to nominate cells to join Change Below to a named rang
instead of an input box
Set rCells = Application.InputBox _
(Prompt:="Select the cells to join," _
& "use Ctrl for non-contiguous cells.", _
Title:="CONCATENATION OF CELLS", Type:=8)

If rCells Is Nothing Then 'Cancelled or mistake
iReply = MsgBox("Invalid selection!", _
vbQuestion + vbRetryCancel)
If iReply = vbCancel Then
On Error GoTo 0
Exit Sub
Else
Run "JoinCells" 'Try again
End If
End If

'Set range variable to first cell
Set rStart = rCells(1, 1)

'Loop through cells chosen
For Each rRange In rCells
strStart = rRange 'parse cell content to a String
rRange.Clear 'Clear contents of cell
'Replace the original contents of first cell with "", then _
join the text Need to put results in a specific cell address
rStart = Trim(Replace(rStart, rStart, "") & " " _
& rStart & " " & strStart)
Next rRange
On Error GoTo 0

End Su

 

[Tom Ogilvy]

To work on cells in a range individually with a formula, you would need to
use an array formula. However, array formulas do not support
concatentation. You might download Laurent Longre's free download that
provides such functionality.

http://longre.free.fr/english/

download the morefunc file. When you uncompress it it contains a help file
explaining how to use the functions provided.