View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.worksheet.functions
OssieMac OssieMac is offline
external usenet poster
 
Posts: 2,510
Default Vertical Concatenate function

Hi again,

The following macro takes your data as the input data and places it in the
format you requested in another worksheet as the output data. You will need
to edit the sheet names between the double quotes just after the Dim
statements if your sheet names are not Sheet1 for the Input data and Sheet2
for the Output data.

It is always best to use a separate output so as not to destroy your
original data. However, ensure that you back up your workbook before
proceeding to install the macro and run it.

You have not indicated if you need help to install the macro so if you do
then please get back to me and I'll provide some instructions but let me know
what version of Excel you are using.

You will see the following comments 'Following line inserts a space between
comments and 'Alternative code inserts a linefeed to wrap text. You can only
use one of these and it is presently set for a space between comments. If you
want a linefeed to wrap the text then place a single quote at start of the
following line:

strComments = strComments & " "

and remove the single quote from the start of this line:

'strComments = strComments & Chr(10)




Sub Concat_Comments()

Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim rngInvoice As Range
Dim invNbr As Range
Dim strComments As String
Dim Invoice As Variant

'Edit with your input sheet name
Set wsInput = Sheets("Sheet1")

'Edit with your output sheet name
Set wsOutput = Sheets("Sheet2")

'Starts as row 2 because of column headers
'Ends at one cell past last data in 1st column.
With wsInput
Set rngInvoice = Range(.Cells(2, 1), _
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0))
End With

'Prepare output sheet with column headers
With wsOutput
.Cells(1, 1) = "Invoice#"
.Cells(1, 2) = "Comments"
End With

'Set Invoice equal to 1st cell in rngInvoice
Invoice = rngInvoice.Cells(1, 1)

For Each invNbr In rngInvoice
If invNbr < Invoice Then 'End of invoice number
With wsOutput
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = Invoice
.Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = strComments
End With
strComments = ""
Invoice = invNbr
End If

If Len(Trim(invNbr.Offset(0, 2))) 0 Then

If Len(Trim(strComments)) 0 Then
'Following line inserts a space between comments
strComments = strComments & " "

'Alternative code inserts a linefeed to wrap text
'strComments = strComments & Chr(10)
End If

strComments = strComments & Trim(invNbr.Offset(0, 2))

End If
Next invNbr

End Sub


Regards,

OssieMac