VBA - copy down a column to keyword, transpose into column on next worksheet

[databaseuniversity]

I'm trying to make a code that would copy cells down a single column until the cell before a keyword, copy these cells, and paste them (transpose them) into a row on a new page. Then it would find the next instance of the keyword and copy from the keyword to the cell before the next keyword and transpose into the next row on the new page.

I would start with this (assuming "flower" is keyword):

flower
rose
$1.79
in stock
flower
hydrangea
$5.00
flower
tulip
flower

and end up with this:

flower rose $1.79 in stock
flower hydrangea $5.00
flower tulip
flower

I tried to modify this code: http://www.ozgrid.com/VBA/transpose-rows.htm

but I'm lost.... Here is what I have:
(excel 2007, windows xp)
---------------------------------------------------------------

Option Explicit

Sub TransposetoKeyword()

Dim lRows As Long, lCol As Long
Dim rCol As Range
Dim lLoop As Long
Dim wsStart As Worksheet, wsTrans As Worksheet

On Error Resume Next
'Get single column range
Set rCol = Application.InputBox(Prompt:="Select single column", _
                                    Title:="TRANSPOSE ROWS", Type:=8)
                                    
'Cancelled or non valid range
    If rCol Is Nothing Then Exit Sub

'I modified this... not sure if I did it right
'Get keyword. type 2 is for text
    Dim keyword As Long
    keyword = Application.InputBox(Prompt:="Select keyword", _
                                    Title:="KEYWORD", Type:=2)
'Cancelled or non valid keyword
    If keyword = 0 Then Exit Sub

    
'Make sure the transpositions will fit
    If lRows > ActiveSheet.Columns.Count Then
        MsgBox "Your 'transpose every x rows' exceeds the columns available"
        Exit Sub
    End If

'Limit range to used cells
    lCol = rCol.Column
    Set rCol = Range(rCol(1, 1), Cells(Rows.Count, lCol).End(xlUp))
    
'Set Worksheet variables
    Set wsStart = ActiveSheet
    Set wsTrans = Sheets.Add()
    wsStart.Select
   
'Loop with step of x and transpose
'This is what I need to fix... so it searches for the keyword and changes the number
'accordingly. Not a fixed number....
    For lLoop = rCol(1, 1).Row To Cells(Rows.Count, lCol).End(xlUp).Row Step lRows
            Cells(lLoop, lCol).Resize(lRows, 1).Copy
            wsTrans.Cells(Rows.Count, "A").End(xlUp)(2, 1).PasteSpecial Transpose:=True
            Application.CutCopyMode = False
    Next lLoop

    On Error GoTo 0


End Sub

Any help is much appreciated. I'm obviously a complete novice at this!

 

[Rick Rothstein]

Give this macro a try...

Sub TransposeBetweenKeywords()
  Dim Ar As Range, LastRow As Long, KeyWord As String
  Const StartRow As Long = 2
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  
  KeyWord = "flower"
  
  With Cells(StartRow, "A").Offset(, 1).Resize(LastRow - StartRow + 1)
    .FormulaR1C1 = "=IF(RC1=""" & KeyWord & """,""X"","""")"
    .Value = .Value
    For Each Ar In .SpecialCells(xlBlanks).Areas
      Ar(1).Offset(-1).Resize(, Ar.Count) = WorksheetFunction.Transpose(Ar.Offset(, -1))
    Next
  End With
  Cells(StartRow, "B").Resize(LastRow - StartRow + 1).SpecialCells(xlBlanks).EntireRow.Delete
  Columns("B").Replace "X", "", xlWhole
  Columns("C").NumberFormat = "$0.00"
End Sub

 

[databaseuniversity]

Thank you very much for your reply.

Unfortunately the results with my actual data (where the keyword was something else but I made to to change it in the VBA code) were that everything was pasted into one long row rather than being divided into rows at the keyword.

Also, the information was pasted onto the same page as my original data (which I of course made a copy of so I haven't lost anything - but this action is undoable) and not into a new sheet.

 

[Rick Rothstein]

Unfortunately the results with my actual data (where the keyword was something else but I made to to change it in the VBA code) were that everything was pasted into one long row rather than being divided into rows at the keyword.

Also, the information was pasted onto the same page as my original data (which I of course made a copy of so I haven't lost anything - but this action is undoable) and not into a new sheet.

Let's take your last paragraph first. My fault... I missed the "new page" part of your original request. As for working with a copy... you (everyone) should always do that when using code obtained from forums... just in case. You could also salvage your original data by exiting Excel without saving. Now, for your first paragraph... I would have to see your actual workbook in order to understand why it is coming out in one long row (that is not what happened with my tests with your posted data). I suspect the keywords in subsequent rows is not "pure" in some way. If you send my your workbook, I'll change my code to account for whatever is going on or, alternately, suggest to you how you can purify the data so my code will work. My email address is rickDOTnewsATverizonDOTnet (replace the uppercase letters with the symbols they spell out).

 

[databaseuniversity]

Thank you for pointing out about how to salvage original data in Excel without saving. I had never thought of that... very clever!

I see that you are right, my data is not "pure".

I will take you up on your very generous offer of sending you my data privately.

Thank you once again for your help!

 

[Rick Rothstein]

NOTE: To anyone thinking of responding to this thread with the information given... DON'T, the sample data is not even close (shape-wise) to the actual data!

I have received the workbook off-line from the OP and will correspond with him privately to see if I can help. I would not feel comfortable posting the data online as it looks like it contains real semi-private information (names, phone numbers). Just so you know, though, the shape of the data is not a simple list. there are related data separated by usually one, but I've seen up to four, blank rows. As for the data itself, we are talking about multi-word entries on every (filled) row, such as website addresses with a descriptive word in front, office locations (for example, "Office: General Science Building, Rm 238"), phone/fax numbers, names, etc. I'll update this thread when I know more.

 

[databaseuniversity]

Just a note that I tried the above code with a different set of data where my data was clean (my keyword was alone in its cell) and it works like a charm for that data set.

- Deanna