race distance using macro

[alrodopial]

There was some code (udf?) for extracting the dist (in furlongs) from text
ie from 2m3f110y

Any help?

[davez]

dont know if this is any help

=LEFT(A1,FIND("m",A1,1)-1)*8+MID(A1,FIND("f",A1,1)-1,1)+MID(A1,5,FIND("y",A1,1)-1-FIND("f",A1,1))*0.00454545455

[alrodopial]

Thanks by I need a macro

[osknows]

Code: Select all

Option Explicit

Sub test()
Dim distance As String
Dim furlongs As Double

    distance = "2m3f110y"
    furlongs = StringToFurlongs(distance)
   
End Sub

Function StringToFurlongs(ByVal dist As String) As Double
Dim dcmiles As Long
Dim dcfurlongs As Long
Dim dcyards As Long
       
        'miles
        If InStr(1, dist, "m") > 0 Then
            dcmiles = Left(dist, InStr(1, dist, "m") - 1)
        Else
            dcmiles = 0
        End If
       
        'furlongs
        If InStr(1, dist, "f") > 0 Then
        dcfurlongs = Mid(dist, InStr(1, dist, "m") + 1, InStr(1, dist, "f") - InStr(1, dist, "m") - 1)
        Else
        dcfurlongs = 0
        End If
       
        'yards (second test is for examples such as 1m100y where no furlongs in distance string)
        If InStr(1, dist, "y") > 0 Then
            If InStr(1, dist, "f") > 0 Then
                dcyards = Mid(dist, InStr(1, dist, "f") + 1, InStr(1, dist, "y") - InStr(1, dist, "f") - 1)
            Else
                dcyards = Mid(dist, InStr(1, dist, "m") + 1, InStr(1, dist, "y") - InStr(1, dist, "m") - 1)
            End If
        Else
            dcyards = 0
        End If
       

        StringToFurlongs = (dcmiles * 8) + dcfurlongs + (dcyards / 220)
       
End Function

[alrodopial]

Thats it,
thanks Os

[mak]

Al exeis pm

[alrodopial]

I changed the code a bit to include the case: 1f100y - no miles in string

Code: Select all

Public Function StringToFurlongs(ByVal dist As String) As Double
   
    Dim dcmiles As Long
    Dim dcfurlongs As Long
    Dim dcyards As Long
   
    'miles
    If InStr(1, dist, "m") > 0 Then
        dcmiles = Left(dist, InStr(1, dist, "m") - 1)
    Else
        dcmiles = 0
    End If
   
    'furlongs (second test is for examples such as 1f100y where no miles in distance string)
    If InStr(1, dist, "f") > 0 Then
        If InStr(1, dist, "m") > 0 Then
            dcfurlongs = Mid(dist, InStr(1, dist, "m") + 1, InStr(1, dist, "f") - InStr(1, dist, "m") - 1)
        Else
            dcfurlongs = Left(dist, InStr(1, dist, "f") - 1)
        End If
    Else
        dcfurlongs = 0
    End If
   
    'yards (second test is for examples such as 1m100y where no furlongs in distance string)
    If InStr(1, dist, "y") > 0 Then
        If InStr(1, dist, "f") > 0 Then
            dcyards = Mid(dist, InStr(1, dist, "f") + 1, InStr(1, dist, "y") - InStr(1, dist, "f") - 1)
        Else
            dcyards = Mid(dist, InStr(1, dist, "m") + 1, InStr(1, dist, "y") - InStr(1, dist, "m") - 1)
        End If
    Else
        dcyards = 0
    End If
   
    StringToFurlongs = (dcmiles * 8) + dcfurlongs + Round((dcyards / 220), 2)
   
End Function

Thanks again Os

[vanbuuts]

Hi, how does this macro run and where does it put the distance?

Also, the formula higher up the thread doesn't seem to work

[Captain Sensible]

It runs the same as other Functions like minusTicks or plusTicks, you'd just enter the value you wanted converted in StringToFurlongs() either in your other macros or in excel like =stringtofurlongs("5f") or if the cell you wanted converting is A1 =stringtofurlongs(A1) .

It's just converting the distance not extracting it from A1, so you'd need to do that separately. I think it was written to parse the Racing Post or other external distances rather than converting A1

[dflowe]

the code for the excel cell don't work either, maybe something changed in the a1 cell?
Dave

[Captain Sensible]

Works OK for me, your excel code was just splitting at the ":" so should pick out the distance for all races except the To be placed ones. You could always tweak the function slightly to remove your excel formula

[dflowe]

Sorry I am lost now, is it this 1 that works:-
=IF(TYPE(FIND("m",AA1))=16,LEFT(AA1,LEN(AA1)-FIND("f",AA1)+1)*1,IF(TYPE(FIND("f",AA1))=16,LEFT(AA1,LEN(AA1)-FIND("m",AA1)+1)*8,LEFT(AA1,FIND("m",AA1)-1)*8+MID(AA1,FIND("m",AA1)+1,FIND("f",AA1)-FIND("m",AA1)*1-1)))
where AA! is the result of:-
IF(MID(A1,FIND(":",A1)+6,1)="",MID(A1,FIND(":",A1)+4,2),MID(A1,FIND(":",A1)+4,3)) giving result in form 3m4, 2m, 7f etc

or is it this 1:-
=LEFT(A1,FIND("m",A1,1)-1)*8+MID(A1,FIND("f",A1,1)-1,1)+MID(A1,5,FIND("y",A1,1)-1-FIND("f",A1,1))*0.00454545455

as i cant get either to work and if there is a correction to make could you please indicate where as I dont see a ":" in either,
sorry not that good with excel, can do basic maths LOL LOL

thanks Dave

[Captain Sensible]

I meant in your excel formula to pick out the distance from the race details in A1. I thought you'd use the Function rather than some long excel formula as it's a lot easier ad could be tweaked to pick out the distance from A1

[Captain Sensible]

Here's a tweaked version of Osknows code so you can simply extract the distance from the A1 string and convert to furlongs. You just use it within any VBA code you use or simply stick this formula in whatever cell you need

Code: Select all

=StringToFurlongs(A1)

The VBA function is as below and you'd just need to add it to a module. https://www.ablebits.com/office-addins- ... cro-excel/

Code: Select all


 Public Function StringToFurlongs(ByVal dist As String) As Double
 
 If InStr(1, dist, ":") > 0 Then
 Dim marketArray() As String
 marketArray = Split(dist, ":")
 dist = Split(marketArray(1), " ")(1)
 Else
 StringToFurlongs = 0
 Exit Function
 End If

       
        Dim dcmiles As Long
        Dim dcfurlongs As Long
        Dim dcyards As Long
       
        'miles
        If InStr(1, dist, "m") > 0 Then
            dcmiles = Left(dist, InStr(1, dist, "m") - 1)
        Else
            dcmiles = 0
        End If
       
       
        If InStr(1, dist, "f") > 0 Then
            If InStr(1, dist, "m") > 0 Then
                dcfurlongs = Mid(dist, InStr(1, dist, "m") + 1, InStr(1, dist, "f") - InStr(1, dist, "m") - 1)
            Else
                dcfurlongs = Left(dist, InStr(1, dist, "f") - 1)
            End If
        Else
            dcfurlongs = 0
        End If
       
         StringToFurlongs = (dcmiles * 8) + dcfurlongs
       
   
    End Function