prizeorama- struck with runtime error 6 overflow vba

[naveenmail4u]

Option Explicit
Public iRecordCount As Integer
Public iEntryCount As Integer


Sub SelectWinners()
' Display winners in a ticket drawing.
' Decide prizes before running routine (e.g. First person gets prize 1, second person gets prize 2).
' Run the Selection/macro one time to have people's tickets tossed out, once selected
' Run the Selection/Macro multiple times to allow the previously chosen tickets to be placed back in the hat


' From a Sheet names "Names"
' Where names and tickets purchased are in a vertical list
' John | 5 (Cell A5 and B5; vertical list)
' Mary | 2
' Bob | (assumed 1)
' Tam | 2
' Cell A5 is named "NameAnchor" and this has a person's name.
' Cell B5 is a numeric value (assumed 1) of how many tickets purchased
' Where Sheet named "NameResults" is empty
'
'
Dim ianswer As Integer

ianswer = MsgBox("Select winners from the list" & vbCrLf & _
"(Previous Results will be erased)", vbYesNoCancel, "PrizeOrama")
If ianswer = vbYes Then
'Continue
Else
Exit Sub
End If



'Position cursor for attractivness:
Sheets("Names").Select
Application.Goto Reference:="R1C26"
Application.Goto Reference:="R1C1"
Application.Goto Reference:="NameAnchor"
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

iRecordCount = 0
iEntryCount = 0

'Delete and Re-create resultant Sheet
ClearPreviousResults

Randomize
A100_ProcessRecords

'Random Numbers were populated in the ResultSheet's Column A, sort by random
'Call this routine mulitple times
A200_SortNameResults (iEntryCount)

'Restore Screen
Application.Goto Reference:="NameAnchor"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

'Report Results:
Range("G13").Value = "Name Records processed: " & iRecordCount
Range("G14").Value = "Tickets processed: " & iEntryCount

'ianswer = MsgBox("Full results can be found in the [NameResults] Sheet. (The first six winners are listed in cell E5)" & vbCrLf & vbCrLf & _
iRecordCount & " Student records processed" & vbCrLf & _
iEntryCount & " chances allowed", vbOKOnly, "PrizeOrama Winner Results")

End Sub




Private Sub A100_ProcessRecords()


Dim strCurrentName As String
Dim iCurrentValue As Integer
Dim i As Integer


Do Until IsEmpty(ActiveCell)
'Get Values for this record
iRecordCount = iRecordCount + 1
strCurrentName = ActiveCell.Value

'Each person can be in the resultant sheet 1 or more times (they bought more tickets)
'Force invalid numeric or non-existent numeric entries to one
If IsNumeric(ActiveCell.Offset(0, 1)) Then
iCurrentValue = ActiveCell.Offset(0, 1).Value
If iCurrentValue = 0 Then iCurrentValue = 1
Else
iCurrentValue = 1
End If

'iEntryCount will be used as the Row-position in the result sheet
'But you have to loop through the values to iterate multiple-line possibilities
'e.g.: Johnny gets 1 record, Suzie might get 5
For i = 1 To iCurrentValue Step 1
iEntryCount = iEntryCount + 1
Worksheets("NameResults").Range("B" & iEntryCount).Value = strCurrentName
Worksheets("NameResults").Range("A" & iEntryCount).Value = "=Rand()"
Next i

'Uncomment for Diagnostic code:
'MsgBox (strCurrentName & " " & iCurrentValue)

'Get next record
ActiveCell.Offset(1, 0).Select
Loop


End Sub


Private Sub A110_FillRandomNumbers(iTopValue As Integer)
'This routine is a different way to build random numbers and is not used
'by this program.
'Normally would be called *after* all ResultNames were populated
'
'Write Random numbers in column A, starting at postion 1 through the number of records
'passed to the module.
'Because names were loaded (alphabetically or in multiple groups of the same name),
'The random numbers will be used to sort the list, then re-randomized and sorted again
'for further scrambling.

Dim i As Integer

Randomize

For i = 1 To iTopValue Step 1
Worksheets("NameResults").Range("A" & i).Value = Int((iTopValue - 1 + 1) * Rnd + 1)
Next i
End Sub


Private Sub A200_SortNameResults(iTopValue As Integer)


'Sort the values in the ResultNames sheet by the random number
'in column A.
'You must pass how many items were loaded into the list; base-1 count.


Range("A1:B" & iTopValue).Select
ActiveWorkbook.Worksheets("NameResults").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("NameResults").Sort.SortFields.Add _
Key:=Range("A1:A" & iTopValue), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("NameResults").Sort
.SetRange Range("A1:B" & iTopValue)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub


Sub ClearPreviousResults()
'Delete *all* data on the result sheet
Sheets("NameResults").Select
Cells.Select
Selection.Clear
Range("A1").Select

Sheets("Names").Select
Range("G13").Value = ""
Range("G14").Value = ""


End Sub




Sub BroadcastWinners()
Dim ianswer As Integer
Dim icount As Integer
Dim strcurrentWinner As String

icount = 0

Do Until ianswer = vbCancel
icount = icount + 1
strcurrentWinner = Worksheets("NameResults").Range("B" & icount).Value


ianswer = MsgBox("Winner #" & icount & " " & strcurrentWinner, vbOKCancel, "Click OK to get next Winner")

Loop

End Sub


Sub HideWinnerPreviewBox()
'
' HideWinnerPreview Macro
' Hide the Golden Winner Preview Box
'


'
Range("D5:E10").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("A5").Select
End Sub
Sub ShowWinnerPreviewBox()
'
' ShowWinnerPreviewBox Macro
' Show the Winner Preview Box
'


'
Range("D5:E10").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.499984740745262
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("A5").Select
End Sub

 

[naveenmail4u]

I wanted to do raffle and got the excel from

keyliner.blogspot.com: PrizeOrama - Raffle Ticket Selection in Excel

it works till 32767 Tickets and if the ticket is above 32767 it shoots the error

 

[V_Malkoti]

Integer variables are stored as 16-bit (2-byte) numbers ranging in value from -32,768 to 32,767.

Consider changing data type of variable. Long (long integer) variables are stored as signed 32-bit (4-byte) numbers ranging in value from -2,147,483,648 to 2,147,483,647. With that, you should be able to iterate over 32767 ticket rows.

 

[Leith Ross]

Hello naveenmail4u,

Change this line...

From

Public iEntryCount As Integer

To

Public iEntryCount As Long

 

[joeu2004]

it works till 32767 Tickets and if the ticket is above 32767 it shoots the error

An educated guess: change Integer to Long everywhere.

 

[naveenmail4u]

This worked