Dear Experts:
I got hundreds of addresses in an excel sheet which need to be
transposed. The addresses are all in one column and arranged as
follows:

Name
Street
City
Tel
Blank row (1 to several)
Name Street
City
Tel
Blank row (1 to several)
etc. (another several hundred addresses more)

A macro should loop thru all these addresses and do the transposing
automatically. The addresses that are transposed should be placed
right next to each and every address.

Help is much appreciated. Thank you very much in advance. Regards,
Andreas

Hi andreas
Try something like this?

Sub transposeAddress()
Application.ScreenUpdating = False
Dim SpaceCount As Integer
Dim TransposeRow As Integer
Dim Transpose As Range
SpaceCount = 0
TransposeCount = 0
Set TransposeCell = Range("C1") 'Select your own cell
Range("A1").Select 'Select your own cell
While SpaceCount < 10 ' select your value
If ActiveCell.Value = "" Then
ActiveCell.Offset(1, 0).Select
SpaceCount = SpaceCount + 1
Else
TransposeCell.Offset(TransposeCount, 0) = ActiveCell.Offset(0, 0)
TransposeCell.Offset(TransposeCount, 1) = ActiveCell.Offset(1, 0)
TransposeCell.Offset(TransposeCount, 2) = ActiveCell.Offset(2, 0)
TransposeCell.Offset(TransposeCount, 3) = ActiveCell.Offset(3, 0)
TransposeCount = TransposeCount + 1
SpaceCount = 0
ActiveCell.Offset(4, 0).Select
End If

Wend
End Sub

Try this code

Sub CombineRows()

LastRow = Range("A" & Rows.Count).End(xlUp).Row
'set rowcount to row where you want 1st entry
RowCount = 1
NewRow = RowCount
Start = False
Do While RowCount <= LastRow
If Start = False Then
If Range("A" & RowCount) < "" Then
Start = True
StartRow = RowCount
End If

Else
If Range("A" & (RowCount + 1)) = "" Then
ColCount = 1
For MoveRow = StartRow To RowCount
Cells(NewRow, ColCount) = Cells(MoveRow, "A")
ColCount = ColCount + 1
Next MoveRow
NewRow = NewRow + 1
Start = False
End If
End If
RowCount = RowCount + 1
Loop

Rows(NewRow & ":" & LastRow).Delete

End Sub


"andreas" wrote:

Dear Experts:
I got hundreds of addresses in an excel sheet which need to be
transposed. The addresses are all in one column and arranged as
follows:

Name
Street
City
Tel
Blank row (1 to several)
Name Street
City
Tel
Blank row (1 to several)
etc. (another several hundred addresses more)

A macro should loop thru all these addresses and do the transposing
automatically. The addresses that are transposed should be placed
right next to each and every address.

Help is much appreciated. Thank you very much in advance. Regards,
Andreas

On Fri, 10 Jul 2009 02:11:25 -0700 (PDT), andreas
wrote:

Dear Experts:
I got hundreds of addresses in an excel sheet which need to be
transposed. The addresses are all in one column and arranged as
follows:

Name
Street
City
Tel
Blank row (1 to several)
Name Street
City
Tel
Blank row (1 to several)
etc. (another several hundred addresses more)

A macro should loop thru all these addresses and do the transposing
automatically. The addresses that are transposed should be placed
right next to each and every address.

Help is much appreciated. Thank you very much in advance. Regards,
Andreas

I don't know what you mean when you write

The addresses that are transposed should be placed
right next to each and every address.

But to transpose a column of address entries, that are located in, let us say,
A2:An, you could use this macro.

To enter this Macro (Sub), <alt-F11 opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8 opens the macro dialog box. Select the macro
by name, and <RUN.

============================================
Option Explicit
Sub TranspAdr()
'Assumes every address group has at least two rows
'Does not test for this
Dim rSrc As Range, rDest As Range, c As Range
Dim i As Long

Set rSrc = Range("A2")
Set rDest = Range("B1")

i = 1
Do
Set rSrc = Range(rSrc, rSrc.End(xlDown))
rSrc.Copy
rDest(i, 1).PasteSpecial Transpose:=True
Application.CutCopyMode = False
Set rSrc = rSrc.End(xlDown).End(xlDown)
i = i + 1
Loop Until rSrc.End(xlDown).Row = Cells.Rows.Count
End Sub
=================================
--ron

On 10 Jul., 12:56, Normek wrote:
Hi andreas
Try something like this?

Sub transposeAddress()
Application.ScreenUpdating = False
Dim SpaceCount As Integer
Dim TransposeRow As Integer
Dim Transpose As Range
SpaceCount = 0
TransposeCount = 0
Set TransposeCell = Range("C1") 'Select your own cell
Range("A1").Select * * * * *'Select your own cell
While SpaceCount < 10 ' select your value
* * If ActiveCell.Value = "" Then
* * * * *ActiveCell.Offset(1, 0).Select
* * * * *SpaceCount = SpaceCount + 1
* * Else
* * * * TransposeCell.Offset(TransposeCount, 0) = ActiveCell.Offset(0, 0)
* * * * TransposeCell.Offset(TransposeCount, 1) = ActiveCell.Offset(1, 0)
* * * * TransposeCell.Offset(TransposeCount, 2) = ActiveCell.Offset(2, 0)
* * * * TransposeCell.Offset(TransposeCount, 3) = ActiveCell.Offset(3, 0)
* * * * TransposeCount = TransposeCount + 1
* * * * SpaceCount = 0
* * * * ActiveCell.Offset(4, 0).Select
* * End If

*Wend
End Sub

Hi Normek,

that's it. Thank you very much for your professional help. Regards,
Andreas

On 10 Jul., 12:56, Joel wrote:
Try this code

Sub CombineRows()

LastRow = Range("A" & Rows.Count).End(xlUp).Row
'set rowcount to row where you want 1st entry
RowCount = 1
NewRow = RowCount
Start = False
Do While RowCount <= LastRow
* *If Start = False Then
* * * If Range("A" & RowCount) < "" Then
* * * * *Start = True
* * * * *StartRow = RowCount
* * * End If

* *Else
* * * If Range("A" & (RowCount + 1)) = "" Then
* * * * *ColCount = 1
* * * * *For MoveRow = StartRow To RowCount
* * * * * * Cells(NewRow, ColCount) = Cells(MoveRow, "A")
* * * * * * ColCount = ColCount + 1
* * * * *Next MoveRow
* * * * *NewRow = NewRow + 1
* * * * *Start = False
* * * End If
* *End If
* *RowCount = RowCount + 1
Loop

Rows(NewRow & ":" & LastRow).Delete

End Sub



"andreas" wrote:
Dear Experts:
I got hundreds of addresses in an excel sheet which need to be
transposed. The addresses are all in one column and *arranged as
follows:

Name
Street
City
Tel
Blank row (1 to several)
Name Street
City
Tel
Blank row (1 to several)
etc. (another several hundred addresses more)

A macro should loop thru all these addresses and do the transposing
automatically. The addresses that are transposed should be placed
right next to each and every address.

Help is much appreciated. Thank you very much in advance. Regards,
Andreas- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

Hi Joel,

it is working as desired. Thank you very much for your terrific help.
Regards, Andreas

On 10 Jul., 13:51, Ron Rosenfeld wrote:
On Fri, 10 Jul 2009 02:11:25 -0700 (PDT), andreas
wrote:





Dear Experts:
I got hundreds of addresses in an excel sheet which need to be
transposed. The addresses are all in one column and *arranged as
follows:

Name
Street
City
Tel
Blank row (1 to several)
Name Street
City
Tel
Blank row (1 to several)
etc. (another several hundred addresses more)

A macro should loop thru all these addresses and do the transposing
automatically. The addresses that are transposed should be placed
right next to each and every address.

Help is much appreciated. Thank you very much in advance. Regards,
Andreas

I don't know what you mean when you write

The addresses that are transposed should be placed
right next to each and every address.

But to transpose a column of address entries, that are located in, let us say,
A2:An, you could use this macro.

To enter this Macro (Sub), <alt-F11 opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8 opens the macro dialog box. Select the macro
by name, and <RUN.

============================================
Option Explicit
Sub TranspAdr()
'Assumes every address group has at least two rows
'Does not test for this
Dim rSrc As Range, rDest As Range, c As Range
Dim i As Long

Set rSrc = Range("A2")
Set rDest = Range("B1")

i = 1
Do
* * Set rSrc = Range(rSrc, rSrc.End(xlDown))
* * rSrc.Copy
* * rDest(i, 1).PasteSpecial Transpose:=True
* * Application.CutCopyMode = False
* * Set rSrc = rSrc.End(xlDown).End(xlDown)
* * i = i + 1
Loop Until rSrc.End(xlDown).Row = Cells.Rows.Count
End Sub
=================================
--ron- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

Hi Ron,

did a couple of adjustments and now it is working as desired. Thank
you very much for your terrific help. Regards, Andreas

On Fri, 10 Jul 2009 07:03:50 -0700 (PDT), andreas
wrote:

Hi Ron,

did a couple of adjustments and now it is working as desired. Thank
you very much for your terrific help. Regards, Andreas

Glad to help. Thanks for the feedback.
--ron