Welcome Guest
You last visited May 21, 2018, 12:40 am
All times shown are
Eastern Time (GMT-5:00)

# Excel User Defined Functions

Topic closed. 8 replies. Last post 12 years ago by lottaloot.

 Page 1 of 1
Pennsylvania
United States
Member #2218
September 1, 2003
5825 Posts
Offline
 Posted: July 24, 2006, 5:19 pm - IP Logged

Thought I would share it with all.

I found this Code searching the Web.

Thought it would be a good learning tool for those interested in VBA (Visual Basic for Applications) and using User Defined Functions (UDF)

## How to Create Excel User Defined Functions

1. Open up a new workbook.
2. Get into VBA (Press Alt+F11)
3. Insert a new module (Insert > Module)
4. Copy and Paste the following code in the right box under “Option Explicit”
`Function GetElement(text As Variant, n As Integer, _ `
`                    delimiter As String) As String `
`'Returns the nth element from a delimited text string `
`    Dim txt, str As String `
`    Dim count, i As Integer `
` `
`'Manipulate a copy of the text string `
`    txt = text `
`     `
`'If a space is used as the delimiter, remove extra spaces `
`    If delimiter = Chr(32) Then txt = Application.Trim(txt) `
` `
`'Add a delimiter to the end of the string `
`    If Right(txt, Len(txt)) <> delimiter Then `
`        txt = txt & delimiter `
`    End If `
` `
`'Initialize count and element `
`    count = 0 `
`    str = "" `
` `
`'Get each element `
`    For i = 1 To Len(txt) `
`        If Mid(txt, i, 1) = delimiter Then `
`            count = count + 1 `
`            If count = n Then `
`                GetElement = str `
`                Exit Function `
`            Else `
`                str = "" `
`            End If `
`        Else `
`            str = str & Mid(txt, i, 1) `
`        End If `
`    Next i `
`    GetElement = "" `
`End Function `
1. Get out of VBA (Visual Basic for Applications) (Press Alt+Q)

Uses for this are the following:

Say for example you copy and pasted a Pick 6 drawing from your official lottery Website.  The winning drawing was 01-02-03-04-05-06.  (Fat chance this every coming out).  You want to get rid of all the “-“ dashes and place the individual numbers in 6 separate cells.

Here’s an example:

In cell A1 you copy and pasted the winning drawing: 01-02-03-04-05-06

Click cell B1

Click Shift+F3

Click "User Defined" in the “Function Category”

On the right under “Function Name”: look for “GetElement”

Highlight “GetElement” and select OK.

In cell B1 enter the following formula:  =GetElement(\$A1,1,"-")

In cell C1 enter the following formula:  =GetElement(\$A1,2,"-")

In cell D1 enter the following formula:  =GetElement(\$A1,3,"-")

In cell E1 enter the following formula:  =GetElement(\$A1,4,"-")

In cell F1 enter the following formula:  =GetElement(\$A1,5,"-")

In cell G1 enter the following formula:  =GetElement(\$A1,6,"-")

You can change the “-“ to “,” or whatever separates the numbers in cell A1.

You can also use this for Pick 3, Pick 4, Cash 5.
Pennsylvania
United States
Member #2218
September 1, 2003
5825 Posts
Offline
 Posted: July 24, 2006, 5:48 pm - IP Logged

Here is code for Sum of Digits in a  cell.

For example:

In cell A1 you have the following Pick 3 number: 123

Follow the same routine for creating a User Defined Function (Above Post)

Enter the following code:

Function SumDigits(Number)
Dim i As Integer
For i = 1 To Len(Number)
SumDigits = SumDigits + Val(Mid(Number, i, 1))
Next i
End Function

Click cell B1

Click Shift+F3

Click "User Defined" in the “Function Category”

On the right under “Function Name”: look for “SumDigits”

Highlight “SumDigits” and select OK.

In cell A1 enter 123

In cell B1 enter the following formula:  =SumDigits(A1)

The sum of the Pick 3 number will be in Cell B1 which should be (6) 1+2+3

You can use this for Pick 3, Pick 4, Cash 5 etc.

COLUMBUS,GA.
United States
Member #4924
June 3, 2004
6332 Posts
Offline
 Posted: July 24, 2006, 5:50 pm - IP Logged

Very good, Steve, thank you. As always, willing to share. I wish, I could spend more time learning macros.

Mid-Missouri
United States
Member #644
August 31, 2002
4271 Posts
Offline
 Posted: July 24, 2006, 6:24 pm - IP Logged

Thanks Steve,

Much appreciated!

Bryan  :)

United States
Member #8160
October 26, 2004
6777 Posts
Offline
 Posted: July 24, 2006, 6:42 pm - IP Logged

Thanks for the info...

check out mysticwomyn Announcers --> http://www.lotterypost.com/thread/140695/673306

You can judge the integrity of a man by the way he treats those that can do nothing for him...

United States
Member #41383
June 16, 2006
1969 Posts
Offline
 Posted: July 26, 2006, 1:06 am - IP Logged

Here is one macro:

Public Sub FindMatches()

Dim x As Variant
Dim MyValues() As String

Application.ScreenUpdating = False

vSearchValue = Trim(InputBox("Please enter values to search for.  Place a space between each value to search for!" & vbCrLf & vbCrLf & "example:      1.99 2.50 3.75"))
vMatch = CInt(InputBox("How many values must match to flag row?"))

x = Split(vSearchValue, " ")

ReDim myvalue(0 To UBound(x))

For i = 0 To UBound(x)

myvalue(i) = CSng(x(i))

Next i

Do While ActiveCell.Row <= Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

For Each vCell In Rows(ActiveCell.Row).Cells

For i = 0 To UBound(MyValues)

If MyValues(i) = vCell Then

vFound = vFound + 1

If vFound = vMatch Then

Rows(ActiveCell.Row).Interior.ColorIndex = 6

GoTo NextRow

End If

Exit For

End If

Next i

Next vCell

NextRow:

vFound = 0

ActiveCell.Offset(1, 0).Select

Loop

End Sub

United States
Member #41383
June 16, 2006
1969 Posts
Offline
 Posted: July 26, 2006, 1:07 am - IP Logged

And here is another variant of the same:

Private Sub CommandButton1_Click()
Dim howmany As Integer, counter As Integer, found As Integer, searchstring() As String, text As String, testcount As Integer
Dim rowcount As Integer, columncount As Integer
howmany = InputBox("how many do you want to search for")
'MsgBox howmany
ReDim searchstring(howmany) As String
For counter = 1 To howmany
text = "Search Item" & Str(counter)
searchstring(counter) = InputBox(text)
'MsgBox searchstring(counter)
Next counter

For rowcount = 1 To 2500
Range("a1").Select
found = 0
ActiveCell.Offset(rowcount, 0).Select
If ActiveCell = "" Then Exit For
For testcount = 1 To howmany
If ActiveCell = searchstring(testcount) Then
found = found + 1
MsgBox found
End If
Next testcount
For columncount = 1 To 50
ActiveCell.Offset(0, columncount).Select
If ActiveCell = "" Then Exit For
For testcount = 1 To howmany
If ActiveCell = searchstring(testcount) Then
found = found + 1
MsgBox found
End If
Next testcount
Next columncount
If found = howmany Then
MsgBox "Found them"
ActiveCell.EntireRow.Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
Next rowcount

End Sub

United States
Member #41383
June 16, 2006
1969 Posts
Offline
 Posted: July 26, 2006, 1:12 am - IP Logged

I use the first one,

What these macros do is when you are in your excel spreadsheet of Keno numbers (or any other numbers) you want to search on, you enable this macro, it will ask you for how long of a string of numbers you want to search on, if you are looking for 6 numbers, you reply '6', if you are looking for 10, you reply '10', and then the next thing it does is ask you for the numbers you want it to search for, and it will find them (if they exist) and hilight each row.  You need to know Excel and how to record a macro within a spreadsheet, and you also need to know how to use/run it.

Warning: I have not used these in over a year, my memory is vague, but you either MUST have your excel spreadsheet in the exact format for each column, or you will need to alter the macro.  I cannot help you with the latter.

But if anyone wants to take these and monkey with them, go for it.

Redford/MI
United States
Member #3396
January 18, 2004
4867 Posts
Offline
 Posted: July 26, 2006, 12:58 pm - IP Logged

Thanks for these codes.  You never know when you may need something like this.

I keep all the codes talked about here in a specific folder in my computer & it's there in case I need it!

L ttaL   T

 Page 1 of 1