help with vba

[carall]

hi, i need some help!

based on the image attached:
I need to concatenate from APPLE to the last column in its row and down all the rows and columns UNTIL It sees APPLE again.

My problem is that I am being able to concatenate but only the first row correctly and some others. (The number of rows under apple are not always the same as you can see , the first, for instance is 2, 4, 3)

So the results would in a cell in the line of apple or last blank line before next apple.

RESULTS ARE IN YELLOW in the image.

your help would be greatly appreciated

thanks!

[carall]

It has been a long time that i dont program in vba so I tried the following (I am a beginner, learn it on my own, so I was trying something like this, unfinished, just a draft)

Dim concat As String
concat = ActiveCell & ActiveCell.Offset(0, 1) & ActiveCell.Offset(0, 2) & ActiveCell.Offset(0, 3) & ActiveCell.Offset(0, 4)

Do
  If ActiveCell = "apple" Then

              End If
        ActiveCell.Offset(-1, 15).Value = concat
            ActiveCell.Select
      Loop Until ActiveCell.Value <> "apple"

 End Sub



 or

 Sub macro()

Dim concat As String
Dim concat1 As String
Dim concat2 As String

Dim stopcell As String
stopcell = "apple"


If ActiveCell = stopcell Then ActiveCell.Select

concat = ActiveCell & ActiveCell.Offset(0, 1) & ActiveCell.Offset(0, 2) & ActiveCell.Offset(0, 3) & ActiveCell.Offset(0, 4)

ActiveCell.Offset(0, 15).Value = concat

If ActiveCell.Offset(1, 0) <> stopcell Then
ActiveCell.Offset(0, 15).Value = concat & ActiveCell.Offset(1, 0) & ActiveCell.Offset(1, 1) & ActiveCell.Offset(1, 2) & ActiveCell.Offset(1, 3) & ActiveCell.Offset(1, 4)

Dim concat2 As String
concat2 = ActiveCell.Offset(0, 15).Value

If ActiveCell.Offset(2, 0) <> stopcell Then
ActiveCell.Offset(0, 15).Value = concat & concat2 & ActiveCell.Offset(2, 0) & ActiveCell.Offset(2, 1) & ActiveCell.Offset(2, 2) & ActiveCell.Offset(2, 3) & ActiveCell.Offset(2, 4)

If ActiveCell.Offset(3, 0) <> stopcell Then
ActiveCell.Offset(0, 15).Value = concat & concat2 & ActiveCell.Offset(3, 0) & ActiveCell.Offset(3, 1) & ActiveCell.Offset(3, 2) & ActiveCell.Offset(3, 3) & ActiveCell.Offset(3, 4)



End If
End If
End If

End Sub

[djjeavons]

Hi

Try the following. Please read the comments and step through it to see how it works.

Private Sub Test()

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim stopWord As String
    stopWord = "apple"

    'Get the last column used so that we know where we will take
    'data from and where we can write concatenated values.
    'Also get the last row used so we know when to stop
    Dim maxColumn As Integer
    Dim maxRow As Integer

    maxColumn = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
    maxRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

    'Loop through the rows until the first stopWord is found
    'and then start concatenating values until the next stopWord
    'keeping track of the stopWord index so as to write the
    'concatenated values on that row in the maxColumn + 1 cell
    Dim currentRow As Integer
    Dim currentColumnIndex As Integer
    Dim concatenatedString As String
    Dim previousStopWordRowIndex As Integer

    previousStopWordRowIndex = 1

    For currentRow = 1 To maxRow

        If LCase(ws.Cells(currentRow, 1).Value) = LCase(stopWord) Then

            'If we have something in concatenatedString then write it out
            If Len(concatenatedString) > 0 Then

                ws.Cells(previousStopWordRowIndex, (maxColumn + 1)).Value = concatenatedString
                previousStopWordRowIndex = currentRow
                concatenatedString = ""

            End If

        End If

        'Concatenate columns
        For currentColumnIndex = 1 To maxColumn
            concatenatedString = concatenatedString & ws.Cells(currentRow, currentColumnIndex).Value
        Next currentColumnIndex

    Next currentRow

    'Write out the last piece
    ws.Cells(previousStopWordRowIndex, (maxColumn + 1)).Value = concatenatedString

End Sub

HTH

[carall]

almost djjeavons !!! im gonna try to work on it!! thank you very much meanwhile!! =) ill let u know djjeavons !