PDA

View Full Version : Solved: Concatenate problem



eburba
11-26-2005, 01:08 PM
I'm looking for a solution to a problem of concatenating cell contents together based on accept/reject criteria in a different cell using either VB or a compact formula. For example if row 3 contains values of either accept or reject I'd like to concatenate the contents of the corresponding column in rows 1 and 2 into a collector cell at the end of row 3. I've tried to represent my end goal below. Any help would be greatly appreciated.

____A ______B _____C ________D ________E ________F _________G
1_ 1.1.1___1.1.2 __1.1.3 _____1.1.4 _____1.1.5 ____1.1.6
2_ Header _Body __Footer _Attachment _Appendix _Glossary
----------------------------------------------------------
3_ accept _reject _accept _reject ______reject ____accept ___1.1.1 Header
______________________________________________________1.1.3 Footer
______________________________________________________1.1.6 Glossary

johnske
11-26-2005, 01:45 PM
Something like this? - Modify to suitSub CatenateIt()
'replace A1:G2 below with your own range
MsgBox Catenate(Range("A1:G2"), " ")
End Sub

'<< Function to concatenate cells in a range >>
Public Function Catenate(MyRange As Range, _
Optional Delimiter As String) As String
Dim Cell As Range, N As Long
N = 1
'go thru MyRange cell by cell and concatenate
For Each Cell In MyRange
If N = MyRange.Cells.Count Then
'we don't need a delimiter after last cell
Catenate = Catenate & Cell
Else
'set your rejection criteria on next line
If Cell <> "Reject" Then
'otherwise we do need a delimiter
Catenate = Catenate & Cell & Delimiter
End If
End If
N = N + 1
Next Cell
Set Cell = Nothing
End Function

eburba
11-26-2005, 04:29 PM
Thanks so much for the help. I tried the VB code and it did create a msgbox with all cells in the range concatenated with a " " delimeter. I'd like the end result to be Cell G:3, in this example, would hold the concatenated values of Cells A1, A2, C1, C2, and F1, F2 corresponding to the accept values in cells A3, C3 and F3.

tpoynton
11-26-2005, 05:27 PM
The formula to do this in a cell is

=IF(A3 = "accept", A1&" " &A2, "")

problem is that this cant be simply copied and pasted, given your current formatting; if you copied and pasted this formula into row 4 it would give you a simple way of getting the appropriate results.

The macro is, of course, much more elegant; you should be able to get the function described above to write to the cells on the spreadsheet instead of the messagebox without too much trouble. if no one has done this by tomorrow, i'll take a look at it again then.

johnske
11-26-2005, 07:40 PM
Not too sure what you meant by the rejection criteria... is this what you mean? (Seeing as the rejection criteria is text, you'd best use "Option Compare Text" to ignore any upper/lower case differences)Option Explicit
Option Compare Text

Sub CatenateIt()
Range("G3").ClearContents
If Range("A3") = "accept" Then Range("G3") = Catenate(Range("G3, A1:A2"), " ")
If Range("C3") = "accept" Then Range("G3") = Catenate(Range("G3, C1:C2"), " ")
If Range("F3") = "accept" Then Range("G3") = Catenate(Range("G3, F1:F2"), " ")
End Sub

'<< Function to concatenate cells in a range >>
Public Function Catenate(MyRange As Range, _
Optional Delimiter As String) As String
Dim Cell As Range, N As Long
N = 1
'go thru MyRange cell by cell and concatenate
For Each Cell In MyRange
If N = MyRange.Cells.Count Then
'we don't need a delimiter after last cell
Catenate = Catenate & Cell
Else
'otherwise we do need a delimiter
Catenate = Catenate & Cell & Delimiter
End If
End If
N = N + 1
Next Cell
Set Cell = Nothing
End Function

eburba
11-26-2005, 07:55 PM
I think it's getting closer. By rejection criteria I meant that when checking each of the cells in the range C1:G1 if any are "accept" the contents of the corresponding cells in row 1 and 2 would be catenated in G3. Thanks again for looking at this

mdmackillop
11-27-2005, 04:21 AM
How about a user defined function.
Add the following code to a standard module and inset =DoCat() into any required cell. A UDF will not format the cell, and this would need to be done manually or by a Sub routine.

Option Explicit
Option Compare Text

Function DoCat()
Dim Cell As Range, MyText As String
Application.Volatile 'Updates if "Accept" changes
MyText = ""
For Each Cell In Range("$A$3:$F$3")
If Cell = "Accept" Then
MyText = MyText & Cell.Offset(-2) & " " & Cell.Offset(-1) & ": " '& Chr(10)
End If
Next
DoCat = Left(MyText, Len(MyText) - 2)
Set Cell = Nothing
End Function



If you want line breaks instead of colons as a separator, use the Chr(10) alternative.

For a Sub routine, try
Sub DoCat()
Dim Cell As Range, MyText As String
i = -1
For Each Cell In Range("$A$3:$F$3")
If Cell = "Accept" Then
i = i + 1
[G3].Offset(i) = Cell.Offset(-2) & " " & Cell.Offset(-1)
End If
Next
Set Cell = Nothing
End Sub
Regards
MD

eburba
11-27-2005, 10:13 AM
Thanks for your help, the UDF works like a charm.

mdmackillop
11-27-2005, 10:18 AM
Glad to help.
If you're happy with the answer, you can mark the thread "Solved" in the Thread Tools drop down.
Regards
MD