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

databaseuniversity

New Member
Joined
Jul 19, 2012
Messages
4
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)
---------------------------------------------------------------
Code:
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!
 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,884
Office Version
  1. 2010
Platform
  1. Windows
Give this macro a try...
Code:
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

New Member
Joined
Jul 19, 2012
Messages
4
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

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,884
Office Version
  1. 2010
Platform
  1. Windows
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

New Member
Joined
Jul 19, 2012
Messages
4

ADVERTISEMENT

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

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,884
Office Version
  1. 2010
Platform
  1. Windows
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

New Member
Joined
Jul 19, 2012
Messages
4
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,846
Messages
5,627,235
Members
416,232
Latest member
Ash1432

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top