Find, Find next, Copy Between, transpose to another sheet. Help...

[cplummer]

Thank you in advance for your help. This is my first post! I need help writing a macro that will look threw multiple sheets in a workbook and spit out results to a worksheet.

1. The data is in one column, column A, on multiple worksheets.
2. The data starts with:
   1. 1969-1-1 West Beverly. (for example)
   2. The "1969" part changes to different years and is not sequential.
   3. The "-1-1" always stays the same.
   4. The "West Beverly" can be any word.
   5. The string is always in the same cell.
   6. There is always a space between the -1-1 and whatever word comes next.
3. In the next cells below the 1969-1-1 West Beverly, random data is captured.
   1. This data consists of word and numbers in multiple cells but always in column A only.
   2. This data can be or varied length.
   3. This data may have blank cells between the next cell.
   4. I need to capture the blanks as well.
4. Then a repeat of the date data will come up. example 2004-1-1 Harvard.

• I need a macro that will crawl down column A.
• Find the first instance of this 1969-1-1 West Beverly data. (I use a *.1.1* now to find these dates)
• Copy it and all data in the next cells below it until it reaches another date data cell.
• Transpose the first data data and all data up to that next date data cell into another worksheet labelled "All" on row a1.
• then go back to the worksheet it started in to the date it found after 1969-1-1 West Beverly and loop thru the process of finding next data, transpose, and copy to the worksheet "All" but on the row below what was just copied over.

I hope this possible. This forum is fantastic!!

 

[cplummer]

I apologize for not being able to upload an example of the data from work. These machines are locked down. I cannot add a program without IT. That could take several days........

 

[hiker95]

cplummer,

Then manually list/enter the data from column A, for at least 10 sets/rows of your raw data.

 

[cplummer]

A

1987-1-1 Everlast
678-598-5896
1400 Penn State
(empty cell)
Rowland
Sample here
bb-1
1988-1-1 Battery
Houston Drive
2300 Unite Way
(empty cell)
king drive
(empty cell)
(empty cell)
10
1900-1-1 Choice Market

Hope this helps..... thanks.........

 

[cplummer]

Sorry...... I just saw you needed 10 sets of the data................

1988-1-1 Battery
Houston Drive
2300 Unite Way
(empty cell)
king drive
(empty cell)
(empty cell)
10
1987-1-1 Everlast
678-598-1111
1400 Penn State Way
(empty cell)
45 Yes 10
Rowland
Sample here
bb-1
(empty cell)
2005-1-1 List Price
drive way near you
onsite option
(empty cell)
2002-1-1 Fixed
Lense Way Road
(empty cell)
your name here
(empty cell)
Listed for sale by owner
list me
add me
1923-1-1 Water Place
(empty cell)
Plaza way, suite 10, box 1
just in case
You need me
funnel cake
(empty cell)
1910-1-1 Copy paper
Letter size
Signature Plaza, Suite 10
(empty cell)
lost files
(empty cell)
(empty cell)
(empty cell)
4 market shift way
bb-12
2008-1-1 Island Cove district
letter way
bb-12
(empty cell)
2005-1-1 data here
address here
no lime in my glass
test two
234
1952-1-1 Napkin
y did You leave home
5
twenty
(empty cell)
jacks
b9 1
1875-1-1 Last one
this should help
you live over here
(empty cell)


**** This type of data is always in column A and needs to be transposed to look like this

A b c d
1988-1-1 Battery Houston Drive 2300 Unite Way (empty cell)
1987-1-1 Everlast 678-598-1111 1400

I did not copy all of the data over as it would be because of the auto wrapping on the forum. But...... you get the idea I hope.

thanks.........

 

[MickG]

Hi, Try this:-
Rsults returned to sheet "All"

[COLOR="Navy"]Sub[/COLOR] MG04Sep49
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c, rw, txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] n, oRay, Prng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] sht [COLOR="Navy"]As[/COLOR] Worksheet, Ray
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] sht [COLOR="Navy"]In[/COLOR] ActiveWorkbook.Worksheets
[COLOR="Navy"]If[/COLOR] sht.Name <> "All" [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]With[/COLOR] sht
[COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] InStr(Dn, "-1-1") [COLOR="Navy"]Then[/COLOR]
            txt = txt & Dn.Address & ","
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
oRay = Split(txt & Rng(Rng.Count).Address, ",")
    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(oRay) - 1
        [COLOR="Navy"]With[/COLOR] .Range(oRay(n), oRay(n + 1))
            [COLOR="Navy"]Set[/COLOR] Prng = .Resize(.Count - 1)
        [COLOR="Navy"]End[/COLOR] With
            c = c + 1
 Sheets("All").Range("A" & c).Resize(, Prng.Count).Value = Application.Transpose(Prng)
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
txt = ""
[COLOR="Navy"]Next[/COLOR] sht
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[cplummer]

This worked perfectly.............. Thank you so much.......

I LOVE THIS FORUM!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!