Urgent Formula/Macros assitance

[Eugene Hirdes]

Hi,

I have an excel spreadsheet with over 70k lines in it for all the different countries(sheet1), it lists various costings for all the countries and the telecom providers which are within those countries. As shown below:

Prefix	Named Route Name	Sell Rate
7840	Abkhazia Fixed	£0.13
7940	Abkhazia Mobile	£0.08
79407	Abkhazia Mobile - A-Mobile	£0.13
79409	Abkhazia Mobile - Aquafon	£0.15
93	Afghanistan Fixed	£0.16
9375	Afghanistan Mobile - At	£0.15
9370	Afghanistan Mobile - AWCC	£0.14
9378	Afghanistan Mobile - Etisalat	£0.12
9377	Afghanistan Mobile - MTN	£0.12
9372	Afghanistan Mobile - Roshan	£0.14
9379	Afghanistan Mobile - Roshan	£0.14
355	Albania Fixed	£0.12
3554249	Albania Fixed - AlbTel	£0.12
3554250	Albania Fixed - OLO	£0.12
3554251	Albania Fixed - OLO	£0.12
3554252	Albania Fixed - OLO	£0.12
3554	Albania Fixed - Tirana	£0.12
35568	Albania Mobile - AMC	£0.22
35567	Albania Mobile - Eagle	£0.18
35566	Albania Mobile - Plus	£0.23
35569	Albania Mobile - Vodafone	£0.15

<tbody>
</tbody>

Column A is the prefix(dialing code) Column b is the Country and the various suppliers and Column c is the cost - Now what I require is a formula to work out the Max value for both fixed and mobile rates, per country and this is to be done on sheet2. Below is an example of what it should look like:

Prefix is done away with and will only have 2 columns Named Route and Selling rate

Col A Col B
Named Route Selling Rate

Abkhazia Fixed

£0.13

<tbody>
</tbody>

Abkhazia Mobile £0.15
Afghanistan Fixed £0.16
Afghanistan Mobile £0.14
Albania Fixed £0.12
Albania Mobile £0.23
etc etc till Zimbabwe

So if there is a formula or anything that could do this Automatically it would be greatly appreciated.
NOTE: I receive updated spreadsheets form my suppliers fortnightly and they sometime add new lines for countries or remove - so was thinking that the easiest would be to use the full range from row1 to 70K+, search for Abkhazia fixed and determine the cost then the same for the rest.....at this point I am about to pull out what little hair I have left- so any assistance or advice is welcome.

 

[CharlesChuckieCharles]

Try this

Sub GetMaxCostPercountry()
Dim rngMyRange As Range
Dim rngMyCell As Range
Dim lRangeRowDepth As Long
Dim lRangeRowDepth2 As Long
'find the depth of the description column
lRangeRowDepth = Cells(Rows.Count, 2).End(xlUp).Row
Set rngMyRange = Range("B2:B" & lRangeRowDepth)
For Each rngMyCell In rngMyRange
   'get fixed or mobile
   rngMyCell.Offset(0, 3).Value = IIf(InStr(1, rngMyCell.Value, "-") > 0, Trim(Left(rngMyCell.Value, (InStr(1, rngMyCell.Value, " -")))), rngMyCell.Value)
   DoEvents
   'build a country list
   rngMyCell.Offset(0, 2).Value = Trim(Replace(Replace(rngMyCell.Offset(0, 3).Value, "Mobile", ""), "Fixed", ""))
   DoEvents
   'take a copy of the price
   rngMyCell.Offset(0, 4).Value = rngMyCell.Offset(0, 1).Value
   
Next rngMyCell
    
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("D2:D" & lRangeRowDepth) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C2:C" & lRangeRowDepth) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A2:F" & lRangeRowDepth)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        
        .Apply
    End With
    Sheets("Sheet2").Select
    Selection.ClearContents
    
    Sheets("Sheet1").Select
    Columns("D:D").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("a1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$2:$A$" & lRangeRowDepth).RemoveDuplicates Columns:=1, Header:=xlNo
    DoEvents
    lRangeRowDepth2 = Cells(Rows.Count, 1).End(xlUp).Row
    Set rngMyRange = Range("$A$2:$A$" & lRangeRowDepth2)
    For Each rngMyCell In rngMyRange
       rngMyCell.Offset(0, 1).Formula = "=IF(Vlookup(" & rngMyCell.Address & ",Sheet1!D2:F" & lRangeRowDepth & ",1,true)<>" & rngMyCell.Address & ",0,Vlookup(" & rngMyCell.Address & ",Sheet1!D2:F" & lRangeRowDepth & ",2,true))"
       DoEvents
       rngMyCell.Offset(0, 2).Formula = "=IF(Vlookup(" & rngMyCell.Address & ",Sheet1!D2:F" & lRangeRowDepth & ",1,true)<>" & rngMyCell.Address & ",0,Vlookup(" & rngMyCell.Address & ",Sheet1!D2:F" & lRangeRowDepth & ",3,true))"
       DoEvents
    Next rngMyCell
DoEvents
    
    Columns("B:C").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

'clear up
Sheets("Sheet1").Select
    Columns("D:F").Select
    Selection.ClearContents

End Sub

select the sheet with the provided data and run macro GetMaxCostPercountry

expects the first sheet is called Sheet1 and the second Sheet2

expects data on sheet1 to start at row 2

 

[Eugene Hirdes]

Thanks will give this a go