VBA code urgently needed!

[burk]

Hello,

I am utterly despaired, as I have to come up with a weird VBA code
although I have never used VBA before...

Here is the the thing:

I Have once Excel sheet (Sheet1.xls) containing two columns: Column A
contains the names of different persons, , & Column B the countries of
the respective persons in alphabetical order; e.g.

ColumnA ColumnB
Pablo Argentina
Estefan Argentina
Michael Austria
Stephanie Austria
Franz Austria
Jerome Belgium
Clara Belgium
Alvaro Chile
Mikele Chile
Emanuele Chile

However, the # of names per country, as well as the countries
themselves, vary from time to time, so the list is not constant!


I know have to export this list in a second worksheet (Sheet2.xls) such
that the countries are displayed as headers in ColumnA, and the
corresponding names are displayed below, whereby the alpabetical order
of the countries is kept and the countryname and the last preceeding
name of a person are separated by an empty row:

ColumnA (Sheet2.xls)
Argentina
Pablo
Estefan

Austria
Michael
Stephan
Franz

Belgium
Jerome
Clara

Chile
etc

The problem is that I have to come up with a Macro that recognises the
country name, displays it as a header, lists all the respectvie names
following this header, then recognises when a new country name comes
up, inserts an empty row, followed by the name of the new country and
the names of the people from this country...
As I said, so sometimes there may be just one name for a given country,
some times 5 names, and some times no names at all!

Any ideas??? Any help is mostly appreciated!
Many thanx!

 

[Bob Phillips]

Sub Test()
Dim iLastRow As Long
Dim i As Long
Dim j As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Worksheets("Sheet2")
Range("B1").Copy .Range("A1")
Range("A1").Copy .Range("A2")
j = 1
For i = 2 To iLastRow
If Cells(i, "B").Value = Cells(i - 1, "B").Value Then
Cells(i, "A").Copy .Cells(.Cells(1, j).End(xlDown).Row + 1,
j)
Else
j = j + 1
Cells(i, "B").Copy .Cells(1, j)
Cells(i, "A").Copy .Cells(2, j)
End If
Next i
End With
End Sub

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Tom Ogilvy]

Change startrow to refer to the first row containing your data. Adjust
worksheet names as necessary.

Option Explicit
Sub NewList()
Dim rng As Range, cell As Range
Dim startrow As Long, sh As Worksheet
Dim rw As Long
startrow = 2
Set sh = Worksheets("Sheet2")
rw = 1
With Worksheets("Sheet1")
Set rng = .Range(.Cells(startrow, 1), _
.Cells(startrow, 1).End(xlDown))
End With
For Each cell In rng
If cell.Row = 1 Or cell.Offset(0, 1) <> _
cell.Offset(-1, 1) Then
If rw <> 1 Then rw = rw + 1
sh.Cells(rw, 1) = cell.Offset(0, 1)
rw = rw + 1
End If
sh.Cells(rw, 1).Value = cell.Value
rw = rw + 1
Next
End Sub

 

[burk]

Thank you so much for your kind replies! Tom's code is almost exactl
what I need, there is just one little issue: the code as it is does no
display the name of the very first country (eg Argentina in the exampl
I gave earlier), but starts immediately with the names of the peopl
from that country

E.g. it gives the following output

Pablo
Estefan

Austria
Michael
Stephan
Franz
etc.....

Instead of

Argentina
Pablo
Estefan

Austria
Michael
Stephan


Any ideas how to fix this using Tom's code? Many thanx

 

[Bob Phillips]

Did you try mine?

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[burk]

Hi Bob,

yes I tried yours - many thanks indeed! But the problem is that you
code gives me all the names in different columns - I need them all i
one and the same column (column A) - Do you have any idea of how t
modify your code accordingly, or else of how to modify Tom's code s
that it also copies the very first country name?

Many thankx

 

[Tom Ogilvy]

Change startrow to refer to the first row containing your data. Adjust

worksheet names as necessary.

so did you change Startrow to 1

 

[Tom Ogilvy]

I did, it placed the data across the sheet rather than down column A as
requested.

 

[burk]

Hello Tom!

thanx for your reply. Yes, I tried setting the start row to 1 in the
"startrow =" argument, but I came up with the following error message"

"Run-time error '1004'


Once I click on "Debug", it highlights the following statement within
the code that you gave me:

If cell.Row = 1 Or cell.Offset(0, 1) <> _
cell.Offset(-1, 1) Then

Specifically. it says that "cell.Offset(-1, 1) = <Application-defined
or object-defined error>

 

[Bob Phillips]

How about this then

Sub Test()
Dim iLastRow As Long
Dim i As Long
Dim j As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Worksheets("Sheet2")
j = 2
Range("B1").Copy .Range("A1")
Range("A1").Copy .Range("A2")
For i = 2 To iLastRow
j = j + 1
If Cells(i, "B").Value = Cells(i - 1, "B").Value Then
Cells(i, "A").Copy .Cells(j, "A")
Else
j = j + 1
Cells(i, "B").Copy .Cells(j, "A")
j = j + 1
Cells(i, "A").Copy .Cells(j, "A")
End If
Next i
End With
End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)