Excel/VBA Emergency Help Needed Please

[majix7]

First off, let me thank the two people who answered my previous questions. They were right on. What a great resource this is.

We are trying to wrap up the mailing for our charity event in California and have one final issue with a set of names here that needs to be solved right away.

There are two worksheets with the following: names, addresses and phone numbers. In both worksheets they reside in column "A".

Examples follow:

John Doe (The name is always in bold)
123 Main St Anytown CA 94111
415-555-1212

Jane Smith (Bold)
456 Main St Anytown CA 94111
415-555-1212

This goes on and on and on. It seems that it is possible to write some code that could search the "A" column starting from the beginning and key on the BOLD name, once it finds a bold name it can then take that name and place it for example "B1", take the address which is always right below it and put it in "C1" and the phone into "D1". It then moves onto the next BOLD name and inserts name into "B2", "C2" and "D2" . going down until it has slotted all the "A" column names to the "B", "C" and "D" columns.

I can then take the zip codes out and put them in another column (already know how to do this thanks to you guys!)

If anyone out there can help with this code, it would be very much appreciated.

 

[brettvba]

Hi Try this assuming there are no spaces between the different names

Sub mx()
Range("a1").Select
For i = 1 To 65536
aCell = Cells(i, 1).Value
If aCell = Empty Then Exit Sub

If Cells(i, 1).Font.Bold = True Then
x = x + 1
Cells(x, 2) = Cells(i, 1).Value
Cells(x, 3) = Cells(i, 1).Offset(1, 0).Value
Cells(x, 4) = Cells(i, 1).Offset(2, 0).Value

Else: End If

Next
End Sub

Brett

 

[Tommy Bak]

Hi
you could also try this even with blank cells.
Sub Transpose()
Dim iRow As Integer
Dim iColumn As Integer
Dim iCounter As Integer
Dim lastrow As Long
iRow = 1
iColumn = 1
iCounter = 1

lastrow = Range("A65536").End(xlUp).Row
While iRow < lastrow
If Range(Cells(iRow, iColumn).Address).Font.Bold = True Then
Range(Cells(iRow, iColumn), Cells(iRow + 2, iColumn)).Copy
Cells(iCounter, iColumn + 1).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
iRow = iRow + 2
iCounter = iCounter + 1
Else
iRow = iRow + 1
End If
Wend
End Sub

 

[majix7]

You guys are THE BEST!. There were spaces between the groups of names. The second Sub did it perfectly. THANK YOU THANK YOU THANK YOU! I am doing a dance for the MrExcel board. Days of work into a push of the button!

 

[PaddyD]

As you've already got a solution, this is just FYI...

You could use the 'Advanced Transposer' funciton in the ASAP utilities addin. This will take data from a single column & transpose it into multiple cols.

If you had data for a single record in every four rows, for example, transpose the col into 4 new ones:

Book3
	A	B	C	D	E
1	This		BecomesThis:
2	one		one	two	three
3	two		four	five	six
4	three		seven	eight	nine
5
6	four
7	five
8	six
9
10	seven
11	eight
12	nine
13
14
Sheet1

The addin is available here:

http://www.asap-utilities.com

Hope this helps,

Paddy

 

[Tommy Bak]

if we were sure that each record was 3 rows and 1 blank this arrayformula put into b1,c1,d1 could also do it (and data starts in A1
{=TRANSPOSE(INDIRECT("A"&ROW()*4-3):INDIRECT("A"&ROW()*4))}

just copy down until error

regards tommy