Macro help that finds text and inserts rows

rocket88

New Member
Joined
Jun 27, 2012
Messages
2
Hello everyone!
I converted a pdf file directory list of names, address, etc to a excel spreadsheet. The list contains about 3000 rows of information all in column A. Some records in the list have 5 fields(rows), some have 7 fields(rows), and so on and so on. They do all have an email address as the last row of their record that could be keyed on for a find/search. So I need a macro that finds the email address of each person in the list and inserts blank rows above it so that there are always an equal number of rows (7 fields/rows for instance) for each record. Then I want to run a macro that copies the entire column and paste's and transposes it into a second sheet so that all the columns line up and with no blank rows. It's amazing how much time a macro can save...! Thanks
 

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
rocket88,

Welcome to the MrExcel forum.

What version of Excel are you using?

Can you post the raw data on one worksheet, and, post the results you are looking for on another worksheet?

To post your data, you can download and install one of the following two programs:
Excel Jeanie
MrExcel HTML Maker

Or, when using Internet Explorer, just put borders around your data in Excel and copy those cells into your post.


If you are not able to give us screenshots:
You can upload your workbook to Box Net,

sensitive data scrubbed/removed/changed

mark the workbook for sharing
and provide us with a link to your workbook.
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Give this a shot with a copy of your sheet

Code:
Sub Addrs()
Dim Area As Range
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If InStr(Range("A" & i).Value, "@") > 0 Then Rows(i + 1).Insert
Next i
For Each Area In Columns("A").SpecialCells(xlCellTypeConstants).Areas
    Area(1).Offset(, 1).Resize(, Area.Rows.Count).Value = Application.Transpose(Area)
Next Area
Columns("A").Delete
Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
 

rocket88

New Member
Joined
Jun 27, 2012
Messages
2
Thanks and sorry for being slow at responding - Your code worked to perfection and saved me a lot of time...
It's amazing what knowledge and a few lines of code can do :)
 

Watch MrExcel Video

Forum statistics

Threads
1,127,263
Messages
5,623,704
Members
415,983
Latest member
MusicMan

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