macros or formulas not sure

[David]

In Excel 2003 I have four long columns 10,000 + rows. A=country, B=city name,
C= year D=city population.
My analysis has two levels of priority. First a way to change a formula that
recognises the date range in col C to track the cities in col D for the next
change in date and RANK them (i.e. E $ 80: E $ 88 being an example of an
array of cites in the same date range) in the sample test for a formula: =
RANK (E80, IF (AND (E80> 0, A80 = A79, C80 = C79), $ 80 E: E $ 88,0))
The number of cities is not the same for each date or for each country.
A second priority which would use one or more macros would carry out the
following steps:
1. Sort the table by column A 'country'
2. Sort by col C date for each country.
3. Sort col D city (population 000s) by size for each date
4. Calculate the RANK of every city in each date and country (- the first
priority)
5. Create a column or other means of eliminating the city name NATION from
the Ranking as this is the country total population .
5. Calculate the log N for Rank and population for each city
6. Compute, a) the slope, b) coefficient of determination and c) the ratio
of city population ranked 1, on adding city (2 +3) / 2, for each country and
date.
Grateful for any suggestion that can help simplifying the scope of this
exercise.

 

[Joel]

Below is code that does everything except 6.

I'm not sure how you want to calculate slope of multiple points. Need more
definition. Best fit formula or some other method. One method is to chart
(can be don with macro) and then add a trendline. The slope can be found
from the trend line.

the macro does a coefficient of determination but not sure if a have the
columns correct. I'm not sure how to do the ration of cities because I'm not
sure what to do if there arren't 3 cities.


Sub Rank_Cities()

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set DataRange = Range("A1" & Lastrow)
DataRange.Sort _
Key1:=Range("A1"), _
Order1:=xlAscending, _
Key2:=Range("C1"), _
Order2:=xlAscending, _
Key3:=Range("D1"), _
Order3:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal

'Add Rank to column E
'Add Log Rank to column F
'Add Log Population to column G
'Add coefficient of determination to column H
RowCount = 1
Rank = 1
FirstRow = RowCount
Do While Range("A" & RowCount) <> ""
If Range("B" & RowCount) = Nation Then
Rank = 1
Else
Range("E" & RowCount) = Rank
Range("F" & RowCount) = Log(Rank)
Range("G" & RowCount) = Log(Range("D" & RowCount))

If Range("B" & RowCount) <> _
Range("B" & (RowCount + 1)) Then

'get correlation of Log columns
'can't get correlation for only one city
If FirstRow <> RowCount Then
Set RankRange = Range("F" & FirstRow & ":F" & RowCount)
Set PopRange = Range("G" & FirstRow & ":G" & RowCount)
correlation = WorksheetFunction.Correl(RankRange, PopRange)
determination = correlation ^ 2
Range("H" & RowCount) = determination
End If
Rank = 1
FirstRow = RowCount + 1
Else
Rank = Rank + 1
End If
End If

RowCount = RowCount + 1
Loop


End Sub

 

[David]

Joel, thanks,
You ask some questions:
1. The slope is LNpop on x LNrank on Y; the function slope (pente in French
which I am using!) asks for x and y filled in by dragging along the two
column relevant cells.
2.The order of columns I have used for inserting the result is at the top of
each country/date array as:
ratio slope coefficient
1.18 -0.78 0.79
3. The object over cases of less than three cities is to use 2 or erase them
manually or within the programme - there are none as far as i can see.
4. I include a copy paste of the first country and date, with A-D as the
base data:
country city date pop th Lnrank Lnpop
ALBANIA NATION 1930 10030 0 #VALEUR!
ALBANIA TIRANE 1930 308 308 1 0.00 5.73
ALBANIA SHKODER 1930 292 292 2 0.69 5.68
ALBANIA KORCE 1930 228 228 3 1.10 5.43
ALBANIA ELBASAN 1930 138 138 4 1.39 4.93
ALBANIA GJIROKASTER 1930 108 108 5 1.61 4.68
ALBANIA BERAT 1930 104 104 6 1.79 4.64
ALBANIA DURRES 1930 97 97 7 1.95 4.57
ALBANIA VLORE 1930 91 91 8 2.08 4.51
ALBANIA KAVAJE 1930 82 82 9 2.20 4.41
ALBANIA KRUE 1930 48 48 10 2.30 3.87
ALBANIA LEZH 1930 30 30 11 2.40 3.40
ALBANIA FIER 1930 18 18 12 2.48 2.89

Thanks again,

David

 

[David]

Joel, thanks,
You ask some questions:
1. The slope is LNpop on x LNrank on Y; the function slope (pente in French
which I am using) asks for x and y filled in by dragging along the two column
relevant cells.
2.The order of columns I have used for inserting the result is at the top of
each country/date array as:
ratio slope coefficient
1.18 -0.78 0.79
3. The object over cases of less than three cities is to use 2 or erase them
manually or within the programme - there are none as far as i can see.
4. I include a copy paste of the first country and date, with A-D as the
base data:
country city date pop th Lnrank Lnpop
ALBANIA NATION 1930 10030 0 #VALEUR!
ALBANIA TIRANE 1930 308 308 1 0.00 5.73
ALBANIA SHKODER 1930 292 292 2 0.69 5.68
ALBANIA KORCE 1930 228 228 3 1.10 5.43
ALBANIA ELBASAN 1930 138 138 4 1.39 4.93
ALBANIA GJIROKASTER 1930 108 108 5 1.61 4.68
ALBANIA BERAT 1930 104 104 6 1.79 4.64
ALBANIA DURRES 1930 97 97 7 1.95 4.57
ALBANIA VLORE 1930 91 91 8 2.08 4.51
ALBANIA KAVAJE 1930 82 82 9 2.20 4.41
ALBANIA KRUE 1930 48 48 10 2.30 3.87
ALBANIA LEZH 1930 30 30 11 2.40 3.40
ALBANIA FIER 1930 18 18 12 2.48 2.89
Thanks again
David

 

[Joel]

Columns D & E were the same on your sample so I eliminated one column. Try
this macro. it is very close to what you need. Minor changes may be needed.

Sub Rank_Cities()

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set DataRange = Range("A2" & Lastrow)
DataRange.Sort _
Key1:=Range("A2"), _
Order1:=xlAscending, _
Key2:=Range("C2"), _
Order2:=xlAscending, _
Key3:=Range("D2"), _
Order3:=xlDescending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal

'Add Rank to column E
'Add Log Rank to column F
'Add Log Population to column G
'Add coefficient of determination to column I
'Add first 3 city ration to column J
RowCount = 2
Rank = 1
FirstRow = RowCount
Do While Range("A" & RowCount) <> ""
If UCase(Range("B" & RowCount)) = "NATION" Then
Rank = 1
NationRow = RowCount
FirstRow = RowCount + 1
Else
Range("E" & RowCount) = Rank
Range("F" & RowCount) = Log(Rank)
Range("G" & RowCount) = Log(Range("D" & RowCount))

If Range("A" & RowCount) <> _
Range("A" & (RowCount + 1)) Then

'get correlation of Log columns
'can't get correlation for only one city
If FirstRow <> RowCount Then
Set RankRange = Range("F" & FirstRow & ":F" & RowCount)
Set PopRange = Range("G" & FirstRow & ":G" & RowCount)
correlation = WorksheetFunction.Correl(RankRange, PopRange)
Slope = WorksheetFunction.Slope(RankRange, PopRange)
Range("H" & NationRow) = Slope
determination = correlation ^ 2
Range("I" & NationRow) = determination

If RowCount - FirstRow >= 2 Then
Range("J" & NationRow) = _
Range("D" & FirstRow) / _
((Range("D" & (FirstRow + 1)) + Range("D" & (FirstRow +
2))) / 2)
End If
End If
Rank = 1
FirstRow = RowCount + 1
Else
Rank = Rank + 1
End If
End If

RowCount = RowCount + 1
Loop


End Sub

 

[David]

Thank you again Joel,
It works with only one slight omission - it calculates the three measures
(slope, ratio and coefficient) only once for each country instead of for each
of the 6 decennial date arrays for each country. Is there a slight amendment
that you can invent and I will insert at the correct line. Wish I was also an
Excel VBA whizz kid.
David

 

[David]

Joel,
In the section below if both "A" s are changed to "C" s then I think it is
going to work:



I have tried it on the same small sample as before and it does work and so
here goes. If you dont hear from me it is OK.


The last section as follows had to be put on one line and a space removed
and is now also ok.

((Range("D" & (FirstRow + 1)) + Range("D" & (FirstRow + 2))) / 2)

Bless you and Thank you - the Impossible always takes a little longer.

David