Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Function to loop through a column and return a value based on an x
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 -- Message posted from http://www.ExcelForum.com |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Return column header based on last value in row | Excel Worksheet Functions | |||
Return Column Heading based on value in row | New Users to Excel | |||
Return sum of values based on lookup-function | Excel Worksheet Functions | |||
Return value in 3rd column based on 2 other columns | Excel Discussion (Misc queries) | |||
Return Range of Numerical Values in Single Column based on Frequency Percentage | Excel Worksheet Functions |