Extracting data and returing to colums.

H

Hendy

I am about half way there, but I need some more help.

These are web inquires that parsed out in the same colum and repeat th
same way all down the page.

I want to be able to use the fields as guidelines to pull the dat
adjacent to it and sent to the new colum. In a way it is transposin
all the data, but I need to pull all the first names of these peopl
and have them align in the first colum. Same for Last name, business
etc.

So if the information that I have come across like this in th
spreadsheet, I just want the customer infomation to move to th
appropriate colums like the third example. I don't need First_Name
Last_ NAME, etc to appear in the columns - just the persons info besid
it. Should I be sending this to a new worksheet?

--- November 14, 2002, 4:59 am -----------------------------------
First_Name test
Last_NAME test
COMPANY_NAME test
ADDRESS_1 test
ADDRESS_2 test
ADDRESS_3 test
CITY test
PROVINCE_STATE test
COUNTRY test
PHONE test
FAX test
EMAIL test
WEBSITE_URL test

--- November 15, 2002, 8:59 am -----------------------------------
First_Name test2
Last_NAME test2
COMPANY_NAME test2
ADDRESS_1 test2
ADDRESS_2 test2
ADDRESS_3 test2
CITY test2
PROVINCE_STATE test2
COUNTRY test2
PHONE test1234
FAX test
EMAIL test
WEBSITE_URL test

--- November 16, 2002, 4:59 am -----------------------------------
First_Name test3
Last_NAME test3
COMPANY_NAME test3
ADDRESS_1 test3
ADDRESS_2 test3
ADDRESS_3 test3
CITY test3
PROVINCE_STATE test3
COUNTRY test3
PHONE test3
FAX test3
EMAIL test3
WEBSITE_URL test3

I want the data to come out like this.

First_Name | Last_NAME | COMPANY_NAME | ADDRESS_1 | ADDRESS_2
test-----------test ------------test--------------- test-----------tes

test2 -------- test2 ---------- test2 ------------- test2---------test

test3 -------- test3 -----------test3 ------------ test3 --------test
 
D

Domenic

Hi Hendy,

Provided that the format is consistent, enter the following formula i
C2, copy across and down:

=OFFSET($B$2,ROW(C1)*15-15+COLUMN()-3,0)

Then, select your new data, and Copy > Paste Special > Values, an
delete your old columns, and add your header in Row 1.

Hope this helps
 
D

db103098

I have a similar problem AND am new to Excel VB. I need a VB program t
transpose rows within a spreadsheet (these are daily spreadsheets) wher
I need to change the data from columns to one row of data for databas
exportation. Columns A - F is 9 rows long and would be considered
data record. The spreadsheet has multiple data records.


Column A
DATE_RECORDED:
PROPERTY_ADDRESS:
LENDER:
TRUSTEE:
TRUSTEE SALE #:
SALE LOCATION:
LAST SALE DATE / PRICE:
ASSESSED VALUE:
YEAR BUILT / LAND_USE:

Column B
data that pertains to column A

Column C
INSTRUMENT_#:
CURRENT_OWNER:
LENDER ADDRESS:
TRUSTEE ADDRESS:
SALE DATE:
<actual space>
LOAN DATE / INSTRUMENT_#:
LOT SQFT / POOL SQFT:

Column D
data that pertains to column C

Column E
ORIGINAL TRUSTOR:
MAILING ADDRESS:
ASSESSOR PARCEL #:
TRUSTEE PHONE:
SALE TIME:
LOAN TYPE:
ORIG AMT / AMT OWED:
HOME SQFT:

Column F
data that pertains to column E

Sorry, the data did not copy/paste very well.

The results that I am looking for will be column headings A - X wit
all of the data from Col's A, C, E and all of the associated data belo
each column heading (database format). Each spreadsheet will hav
multiple data records, so I would need a VB script to extract the dat
for the entire spreadsheet and place the data into a new spreadsheet.


COLUMN HEADINGS:

DATE_RECORDED // PROPERTY_ADDRESS // LENDER // TRUSTEE // TRUSTEE_SALE
// SALE_LOCATION // LAST_SALE_DATE / PRICE // ASSESSED_VALUE /
YEAR_BUILT / LAND_USE // INSTRUMENT# // CURRENT_OWNER // LENDER_ADDRES
// TRUSTEE_ADDRESS // SALE_DATE // LOAN_DATE / INSTRUMENT# // LOT_SQFT
POOL_SQFT // ORIGINAL_TRUSTOR // MAILING_ADDRESS // ASSESSOR_PARCEL# /
TRUSTEE_PHONE // SALE_TIME // LOAN_TYPE // ORIG_AMT / AMT_OWED /
HOME_SQFT //

DATA FOR EACH COLUMN:
7/28/2004 // 123 main st, tuba city, AZ 85000 // ABC MTG CO // XY
TRUST CO // 1378522 // MAIN STEPS, SUPERIOR COURT BLDG, 201
JEFFERSON, PHX, AZ // _/ _$0.00 $65,000.00 // 1965 _/ _01-31 /
123456789 // Ron and Donna McDonald // 123 MAIN ST, LINCOLN, NE 1234
// 123 MAIN ST, YUMA, AZ 85000 // 10/28/2004 // 10/23/2003
/0123456789 // 8772 SQFT _/ _512 // Ron and Donna McDonald // 123 mai
st, tuba city, AZ 85000 // 123456 // (000) 555-1212 // 11:00 // /
$33,225.00 _/ _$0.00 // 1548

Thanks in advance, any help would be appreciated
 
D

Dave Peterson

One way is to do a series of copy, then paste special|transpose. Then clean up
those cells you don't want.

Option Explicit
Sub testme01()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim oRow As Long
Dim iCol As Long

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

With curWks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

oRow = 1
For iCol = 1 To 3
.Cells(1, (iCol * 2) - 1).Resize(9, 1).Copy
newWks.Cells(1, (iCol - 1) * 9 + 1).PasteSpecial Transpose:=True
Next iCol

For iRow = FirstRow To LastRow Step 9
oRow = oRow + 1
For iCol = 1 To 3
.Cells(iRow, 2 * iCol).Resize(9, 1).Copy
newWks.Cells(oRow, (iCol - 1) * 9 + 1).PasteSpecial _
Transpose:=True
Next iCol
Next iRow

With newWks
.Range("o1,r1,aa1").EntireColumn.Delete
.Range("A1").EntireColumn.NumberFormat _
= curWks.Range("b1").NumberFormat
.Rows(1).Replace what:=":", replacement:="", _
lookat:=xlPart, MatchCase:=False
.UsedRange.Columns.AutoFit
End With
End With

End Sub
 
D

db103098

Dave,

Your work is excellent. The only problem that is happening is tha
when it copies the data to the next row, it is moving the data over b
2 - 3 columns on each paste (like it is picking up blank cells). I
there a possible fix for that? I have been trying to change things o
the program, but nothing that I am trying is working. Your additiona
help would be greatly appreciated.

Thanks in advance,
Debra
 
D

Dave Peterson

hmmmmm.

I put test data in a1:g20. Just =cell("address",a1) and converted to values.

So it looked like:
$A$1 $B$1 $C$1 $D$1 $E$1 $F$1 $G$1
$A$2 $B$2 $C$2 $D$2 $E$2 $F$2 $G$2
$A$3 $B$3 $C$3 $D$3 $E$3 $F$3 $G$3
$A$4 $B$4 $C$4 $D$4 $E$4 $F$4 $G$4
$A$5 $B$5 $C$5 $D$5 $E$5 $F$5 $G$5
$A$6 $B$6 $C$6 $D$6 $E$6 $F$6 $G$6
$A$7 $B$7 $C$7 $D$7 $E$7 $F$7 $G$7
$A$8 $B$8 $C$8 $D$8 $E$8 $F$8 $G$8
$A$9 $B$9 $C$9 $D$9 $E$9 $F$9 $G$9
$A$10 $B$10 $C$10 $D$10 $E$10 $F$10 $G$10
$A$11 $B$11 $C$11 $D$11 $E$11 $F$11 $G$11
$A$12 $B$12 $C$12 $D$12 $E$12 $F$12 $G$12
$A$13 $B$13 $C$13 $D$13 $E$13 $F$13 $G$13
$A$14 $B$14 $C$14 $D$14 $E$14 $F$14 $G$14
$A$15 $B$15 $C$15 $D$15 $E$15 $F$15 $G$15
$A$16 $B$16 $C$16 $D$16 $E$16 $F$16 $G$16
$A$17 $B$17 $C$17 $D$17 $E$17 $F$17 $G$17
$A$18 $B$18 $C$18 $D$18 $E$18 $F$18 $G$18
$A$19 $B$19 $C$19 $D$19 $E$19 $F$19 $G$19
$A$20 $B$20 $C$20 $D$20 $E$20 $F$20 $G$20


Then I ran the macro and I got this:

in columns A:I,
$A$1 $A$2 $A$3 $A$4 $A$5 $A$6 $A$7 $A$8 $A$9
$B$1 $B$2 $B$3 $B$4 $B$5 $B$6 $B$7 $B$8 $B$9
$B$10 $B$11 $B$12 $B$13 $B$14 $B$15 $B$16 $B$17 $B$18
$B$19 $B$20

in J:p,
$C$1 $C$2 $C$3 $C$4 $C$5 $C$7 $C$8
$D$1 $D$2 $D$3 $D$4 $D$5 $D$7 $D$8
$D$10 $D$11 $D$12 $D$13 $D$14 $D$16 $D$17
$D$19 $D$20

and in Q:X,
$E$1 $E$2 $E$3 $E$4 $E$5 $E$6 $E$7 $E$8
$F$1 $F$2 $F$3 $F$4 $F$5 $F$6 $F$7 $F$8
$F$10 $F$11 $F$12 $F$13 $F$14 $F$15 $F$16 $F$17
$F$19 $F$20

The headers in A1:A9, C1:C8 (dropping the 6th and 9th), and E1:E8 (dropping the
9th) worked ok.

The data looked ok, too.

When I did my original testing, my data was just values--no formulas. Any
chance you have formulas in your range that are evaluating differently now?

If yes, then change a couple lines to copy|paste special|values:

Option Explicit
Sub testme01()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim oRow As Long
Dim iCol As Long

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

With curWks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

oRow = 1
For iCol = 1 To 3
.Cells(1, (iCol * 2) - 1).Resize(9, 1).Copy
newWks.Cells(1, (iCol - 1) * 9 + 1).PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
Next iCol

For iRow = FirstRow To LastRow Step 9
oRow = oRow + 1
For iCol = 1 To 3
.Cells(iRow, 2 * iCol).Resize(9, 1).Copy
newWks.Cells(oRow, (iCol - 1) * 9 + 1).PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
Next iCol
Next iRow

With newWks
.Range("o1,r1,aa1").EntireColumn.Delete
.Range("A1").EntireColumn.NumberFormat _
= curWks.Range("b1").NumberFormat
.Rows(1).Replace what:=":", replacement:="", _
lookat:=xlPart, MatchCase:=False
.UsedRange.Columns.AutoFit
End With
End With

End Sub

======

You don't have any hidden columns in your data????
 
D

db103098

Dave,

YOU ARE THE BOMB!!!!! The program/MACRO worked the 2nd time around.
The problem that I found was that after each set of records (9 ROWS)
there are 2 blank rows. Is there a quick and dirty program to eithe
bypass the blank rows during the macro OR delete them and then have th
program run? I tried to unhide and there were no hidden rows. Also, n
formulas. Thanks again, you have save me many headaches. Also, ca
this be placed in a general area to run on any spreadsheet (I hav
multiples)?

Debra;
 
D

Dave Peterson

If you always have two blank rows after the 9 grouped rows, then I'd just delete
them (rather than fiddle with the code).

Select column A.
Edit|goto|special
click on Blanks
Edit|Delete|entireRow.

This will delete all rows that have an empty cell in column A.

If you have to do this routine regularly, you could modify this line of code:

For iRow = FirstRow To LastRow Step 9
to
For iRow = FirstRow To LastRow Step 11

======

I think I'd clean up the file and eliminate those blank rows. I think that I
might miss if the number of blank rows varied (sometimes 2, sometimes 3, etc).

If I have a choice, I like clean data.
 
D

db103098

Dave,

I will try that to see what happens. Thanks again, you ARE th
best!!!!!

Debr
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top