in the code:
Sub sync()
Dim Dindex As Long 'the index of the D value we are on currently.
Dim Aindex As Long 'the index of the A value we are on currently
Dim Gindex As Long 'the index of the A value we are on currently
Dim Dvalue As Double 'the cell in D value we want to normalize by -time
Dim Avalue As Double 'the A cell value - time
Dim Bvalue As Double
Dim Hvalue As Double
Dim Gvalue As Double 'the G cell value - time
Dindex = 3
Aindex = 3
Gindex = 3
Dvalue = Cells(Dindex, 4).Value 'start value
Avalue = Cells(Aindex, 1).Value 'start value
Gvalue = Cells(Gindex, 7).Value
Do While Dvalue <> 0
Do While Avalue < Dvalue
Aindex = Aindex + 1
Avalue = Range("A" & CStr(Aindex)).Value
Loop
Do While Gvalue < Dvalue
Gindex = Gindex + 1
Gvalue = Range("G" & CStr(Gindex)).Value
Loop
Bvalue = Cells(Aindex, 2)
If Avalue <> Dvalue Then
Aindex = Aindex - 1
Bvalue = (Bvalue + Range("A" & CStr(Aindex)).Value) / 2
End If
Hvalue = Cells(Gindex, 8).Value
If Gvalue <> Dvalue Then
Gindex = Gindex - 1
Hvalue = (Hvalue + Range("G" & CStr(Gindex)).Value) / 2
End If
Cells(Dindex, 10).Value = Dvalue
Cells(Dindex, 11).Value = Bvalue
Cells(Dindex, 12).Value = Hvalue
Dindex = Dindex + 1
Dvalue = Cells(Dindex, 4).Value
Loop
End Sub
I got the error when in the line: Avalue = Range("A" & CStr(Aindex)).Value when the value Aindex got to 1048577. I suspect that the problem is in me trying to reach to such a large cell, the goal of the code is to put 3 different time systems values on the same time system, so I need to reach beyond that cell.
thanks to BigBen I found out that that the maximum value of an excel column is 1048576, and successfully fixed my code.
Related
My code run perfectly but when it comes to add duration more than 24 hours, the code return time of next day. Please see image:
For instance:
CELL(C3)-0500_1145-DURATION IS 6.45
CELL(D3)-CTC-THE CODE WILL IGNORE AND MOVE TO NEXT CELL
CELL(E3)-0500_1145-DURATION IS 6.45
CELL(F3)-0500_1145-DURATION IS 6.45----TOTAL
DURATION=6.45(C3)+6.45(E3)+6.45(F3)=20.15
CELL(G3) & CELL(I3)-OFF -THE CODE WILL IGNORE AND MOVE TO NEXT CELL
CELL(H3)-1000_1800(ACP)-DURATION IS 8
Although the code calculate the duration right here i.e 8 hours but when the system sum all the duration it should give 28:15 but the system is taking it as next day and return total duration as 4:15.
My issue is that how can i make the system to return 28 hours 15 mins(28:15) iso of 4:15 when duration is more than 24 hours.
Sub CalculateHourly()
Dim j As Long
Dim TextTime, wStart, wStop, midnight As String
Dim TrueTime, Temp As Date
Dim Parts As Variant
Dim lRow As Long
Application.Calculation = xlManual
midnight = "24" & ":" & "00"
'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To lRow
For j = 3 To 9
TextTime = ""
'copy content of the cells
TextTime = ThisWorkbook.Application.Sheets("Sheet1").Cells(i, j).Value
'loop only of cell does not contain any text
If InStr(1, TextTime, "CTC", vbTextCompare) = 0 And InStr(1, TextTime, "OFF", vbTextCompare) = 0 And InStr(1, TextTime, "LEAVE", vbTextCompare) = 0 _
And Not IsEmpty(TextTime) Then
Parts = Split(TextTime, "_")
'Left(Parts(0), 2) of 0430-04
'Right(Parts(0), 2) of 0430-30
wStart = Left(Parts(0), 2) & ":" & Right(Parts(0), 2)
'wStop = Left(Parts(1), 2) & ":" & Right(Parts(1), 2)
wStop = Left(Parts(1), 2) & ":" & Mid(Parts(1), 3, 2)
Debug.Print ("test : " & Format(wStart, "h:mm;#"))
'If timeout is less than timein
If wStart > wStop Then
'Add 24 hours and make the diff
TrueTime = 24 + CDate(CDate(CDate(Format(wStop, "h:mm;#")) - CDate(Format(wStart, "h:mm;#"))))
Else
'if timeout greater than timein
TrueTime = CDate(CDate(CDate(Format(wStop, "h:mm;#")) - CDate(Format(wStart, "h:mm;#"))))
End If
**If (Temp + TrueTime) > 24 Then
TrueTime = 24 + Temp + TrueTime**
Else
TrueTime = Temp + TrueTime
End If
Temp = TrueTime
End If
Next j 'move to the number column in the same row
Cells(i, 10).Value = CDate(Format(Temp, "h:mm;#"))
Temp = Temp - Temp
Next i 'move to the next row
End Sub
Use a function like this to format to hours:minutes only:
Public Function FormatHourMinute( _
ByVal datTime As Date, _
Optional ByVal strSeparator As String = ":") _
As String
' Returns count of days, hours and minutes of datTime
' converted to hours and minutes as a formatted string
' with an optional choice of time separator.
'
' Example:
' datTime: #10:03# + #20:01#
' returns: 30:04
'
' 2005-02-05. Cactus Data ApS, CPH.
Dim strHour As String
Dim strMinute As String
Dim strHourMinute As String
strHour = CStr(Fix(datTime) * 24 + Hour(datTime))
' Add leading zero to minute count when needed.
strMinute = Right("0" & CStr(Minute(datTime)), 2)
strHourMinute = strHour & strSeparator & strMinute
FormatHourMinute = strHourMinute
End Function
Sub CalculateHourly2()
Dim j As Long
Dim TextTime As String, wStart As Date, wStop As Date, midnight As String
Dim Parts As Variant
Dim lRow As Long
Dim vArray() As Variant, n As Integer
Application.Calculation = xlManual
'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To lRow
n = 0
For j = 3 To 9
TextTime = ""
'copy content of the cells
TextTime = ThisWorkbook.Application.Sheets("Sheet1").Cells(i, j).Value
'loop only of cell does not contain any text
If InStr(1, TextTime, "CTC", vbTextCompare) = 0 And InStr(1, TextTime, "OFF", vbTextCompare) = 0 And InStr(1, TextTime, "LEAVE", vbTextCompare) = 0 _
And TextTime <> "" Then '<~~ Unlike the case where the cell is empty, if you put an empty cell into a variable, it is not empty.
Parts = Split(TextTime, "_")
'Left(Parts(0), 2) of 0430-04
'Right(Parts(0), 2) of 0430-30
wStart = TimeValue(Left(Parts(0), 2) & ":" & Right(Parts(0), 2))
'wStop = TimeValue(Left(Parts(1), 2) & ":" & Right(Parts(1), 2))
wStop = Left(Parts(1), 2) & ":" & Mid(Parts(1), 3, 2) '<~~ Since other characters have been added, the mid sentence must be used.
n = n + 2
ReDim Preserve vArray(1 To n)
vArray(n - 1) = wStart
vArray(n) = wStop
End If
Next j 'move to the number column in the same row
'Cells(i, 10).Value = CDate(Format(Temp, "h:mm;#"))
If n > 0 Then
Cells(i, 10).Value = getTime(vArray)
Cells(i, 10).NumberFormat = "[hh]:mm"
End If
Next i 'move to the next row
End Sub
Function getTime(Other() As Variant)
Dim myTime As Date, s As Date, e As Date
Dim i As Integer
For i = LBound(Other) To UBound(Other) Step 2
s = Other(i)
e = Other(i + 1)
If s > e Then
e = e + 1
End If
myTime = myTime + e - s
Next i
getTime = myTime
End Function
Sheet Image
i am new here and this is my first question, also i dont speak english so my code (variables) is sometimes in dutch.
I have a workbook with multiple sheets (reservations, cottages, validator and schedule). Schedule needs to be filled in with the correct cottage for the reservation.
My question: I want the cottage_id to be returned with the match function. I need the cottage_id (Which is in column A of the cottagesheet), where the class is correct and where the cottage size is correct.
i've tried so much but nothing seems to work
i get error messages like 'type mismatch' and invalid procedure call or argument.
thankyou in advance!
My code:
Dim i As Integer
Dim c As Integer
Dim d As Integer
Dim numrows As Long
Dim laatstekolom As Long
Dim cottagerow As Variant
Dim class As Integer
Dim guests As Variant
Dim cottage_size As Integer
Dim som As Long
Dim somrng As Range
Dim resKlasse As Integer
Dim cottageId As Integer
Dim klasserij As Range
Dim maxpersrij As Range
Dim zoekklasse As Integer
Set roostersheet = Worksheets("rooster")
Set Reservationsheet = Worksheets("reservations")
Set Cottagesheet = Worksheets("cottages")
Set validatorsheet = Worksheets("validator")
Set lookupsheet = Worksheets("lookup")
roostersheet.Cells(1, 1) = "Cottage_id"
'datum uit reservationssheet naar header roostersheet
For i = 1 To 42
roostersheet.Cells(1, 2) = Reservationsheet.Cells(2, 2)
roostersheet.Cells(1, 2 + i) = Reservationsheet.Cells(2, 2) + i
Next i
'cottageid uit cottagesheet naar 1e kolom roostersheet
For i = 1 To 819
roostersheet.Cells(2, 1) = Cottagesheet.Cells(2, 1)
roostersheet.Cells(i + 2, 1) = Cottagesheet.Cells(2, 1) + i
Next i
'fixed in rooster plaatsen
numrows = Reservationsheet.UsedRange.Rows.Count
laatstekolom = roostersheet.UsedRange.Columns.Count
Resnr = validatorsheet.Range("A:A")
For i = 2 To numrows
If Reservationsheet.Cells(i, 16).Value <> 0 Then
cottagerow = Reservationsheet.Cells(i, 16).Value - 1
validatorsheet.Cells(i - 1, 2).Value = Reservationsheet.Cells(i, 16).Value
End If
For d = 2 To laatstekolom
If Reservationsheet.Cells(i, 2) = roostersheet.Cells(1, laatstekolom) Then
Range(roostersheet.Cells(cottagerow, datumkolom), roostersheet.Cells(cottagerow, laatstekolom + Reservationsheet.Cells(i, 3).Value - 1)).Value = Reservationsheet.Cells(i, 1).Value
End If
Next d
Next i
'reserveringen eisen sum = 0
For class = 4 To 1 Step -1
For i = 2 To numrows
guests = Reservationsheet.Cells(i, 4).Value
'juiste cottagesize
If guests = 1 Then
cottage_size = 2
ElseIf guests = 2 Then
cottage_size = 2
ElseIf guests = 3 Then
cottage_size = 4
ElseIf guests = 4 Then
cottage_size = 4
ElseIf guests = 5 Then
cottage_size = 5
ElseIf guests = 6 Then
cottage_size = 6
ElseIf guests = 7 Then
cottage_size = 8
ElseIf guests = 8 Then
cottage_size = 8
Else: cottage_size = 12
End If
zoekklasse = class
lookupsheet.Cells(1, 1).Value = zoekklasse
lookupsheet.Cells(1, 2).Value = cottage_size
If Application.WorksheetFunction.sum(Reservationsheet.Cells(i, 6), Reservationsheet.Cells(i, 15)) = 0 And Reservationsheet.Cells(i, 5).Value = class And Reservationsheet.Cells(i, 4).Value = cottage_size Then
Dim klasseKolom As Variant
Dim SizeKolom As Variant
Dim test As String
Set klasseKolom = Cottagesheet.UsedRange.Columns(3)
Set SizeKolom = Cottagesheet.UsedRange.Columns(2)
' cottageId = Application.Match(1, (klasseKolom = "&zoekklasse&") * (SizeKolom = "&cottage_size&"), 0)
cottageId = Evaluate("MATCH(1, ('lookupsheet'!A1="""&klasseKolom&""") * ('lookupsheet'!A2 = """&SizeKolom&"""), 0)")
'If Application.WorksheetFunction.sum(jjuyiReservationsheet.Cells(i, 6), Reservationsheet.Cells(i, 15)) = 0 And Reservationsheet.Cells(i, 5).Value = class and Then
'validatorsheet.Cells(cottageId, 2).Value = cottagesheet.Cells(i, 1).Value 'invullen in validatorsheet
'Else
'validatorsheet.Cells(i, 2).Value = "x"
End If
'ElseIf som <> 0 Then
Next i
Next class
End Sub
Try the following...
cottageId = Evaluate("MATCH(1,(" & klasseKolom.Address(External:=True) & "=" & zoekklasse & ")*(" & SizeKolom.Address(External:=True) & "=" & cottage_size & "),0)")
Then you can test whether there's a match as follows...
If Not IsError(cottageId) Then
MsgBox cottageId, vbInformation
Else
MsgBox "cottageId not found!", vbExclamation
End If
The code below works fine until more there is more then 360 rows to cycle through. If there are more than 360 rows, nothing after the bottom loop runs. In fact the code stops looping through the top loop on row 361 at the place indicated below.
I changed all row variables from integer to long and played around with the row numbers to narrow down the row number the problem occurs. If I have less than 361 rows, the code runs fine.
Option Explicit
'Process report variables
Dim ProcRowCount As Long
Dim Process As String
Dim ProcSID As String
Dim ProcStat As String
Dim ProcBeg As Date
Dim ScheRow As Long
Dim ProcRow As Long
Dim OffName As String
Dim DueDate As Date
Dim procserv As Integer
'event report variables
Dim SchEvent As String
Dim EventSID As String
Dim EventRow As Long
Dim Event2025 As String
Dim EventOut As String
Dim EventDate As Date
Dim Eventdate2 As Date
Dim EventDue As Date
Dim NameSID As String
Dim AttempDate As Date
Dim AttempDate2 As Date
Public Sub Update_Process()
With ThisWorkbook.Worksheets("Process")
ProcRowCount = Worksheets("Process").Cells(Rows.Count, "a").End(xlUp).Row
ProcRow = 1
DueDate = Date - 30
Worksheets("Dashboard").Range("ag5:ag500").ClearContents
Set Case_Status = Worksheets("Tables").ListObjects("Case_Status")
Set Events = Worksheets("Tables").ListObjects("Events")
Set Occurrence = Worksheets("Tables").ListObjects("Occurrence")
'checks for offender to be in an active status and that the process
'has been in status date for more than 30 days
Do While ProcRow <= ProcRowCount
ProcStat = Worksheets("Process").Cells(ProcRow, "f")
If ProcStat = "txt_supervision_code" Or ProcStat = "" Then
On Error Resume Next
ProcRow = ProcRow + 1
ElseIf ProcStat <> "txt_supervision_code" Then
ProcBeg = Worksheets("Process").Cells(ProcRow, "m")
Active = Application.WorksheetFunction.VLookup(ProcStat, Case_Status.Range, 3, False)
If Active = "No" Then
ProcRow = ProcRow + 1
ElseIf ProcBeg < DueDate Then
ProcSID = Worksheets("Process").Cells(ProcRow, "B")
Process = Worksheets("Process").Cells(ProcRow, "l")
OffName = Worksheets("Process").Cells(ProcRow, "c")
Call EventReview
ProcRow = ProcRow + 1
Else: ProcRow = ProcRow + 1
End If
End If
Loop
End With
Worksheets("Dashboard").Range("BG4") = procserv
End Sub
Private Sub EventReview()
'Loop though 2025 to see if a case audit or offender contact was documented on the case
With ThisWorkbook.Worksheets("2025")
ScheRow = Worksheets("2025").Cells(Rows.Count, "a").End(xlUp).Row
EventRow = 2
EventSID = Worksheets("2025").Cells(EventRow, "a")
Do While EventRow <= ScheRow
Event2025 = Worksheets("2025").Cells(EventRow, "J")
EventOut = Worksheets("2025").Cells(EventRow, "Q")
EventSID = Worksheets("2025").Cells(EventRow, "A")
EventDue = Worksheets("2025").Cells(EventRow, "O")
CaseReview = Application.WorksheetFunction.VLookup(Event2025, Events.Range, 3, False) ***Once on row 361, the loop stops here and goes back to the public sub
OffenderCon = Application.WorksheetFunction.VLookup(Event2025, Events.Range, 2, False)
EventOccurred = Application.WorksheetFunction.VLookup(EventOut, Occurrence.Range, 6, False)
If ProcSID = EventSID And EventOccurred = "Yes" And (CaseReview = "Yes" Or OffenderCon = "Yes") And _
EventDue > DueDate Then
EventDate = Worksheets("2025").Cells(EventRow, "o")
If Event2025 = "Process Service" And Process = "A-Warr" Then
procserv = procserv + 1
End If
If Eventdate2 = "12:00:00 AM" Or Eventdate2 < EventDate Then
Eventdate2 = EventDate
EventRow = EventRow + 1
Else: EventRow = EventRow + 1
End If
Else: EventRow = EventRow + 1
End If
Loop
NameSID = OffName & " " & ProcSID
'loop through pivot table, insert date in offset column
With ThisWorkbook.Worksheets("Dashboard")
Set pvt = Worksheets("Dashboard").PivotTables("ProcessPivot")
Set Rng = pvt.DataBodyRange
For Each cell In Rng
If cell = NameSID And Eventdate2 <> "12:00:00 AM" Then
cell.Offset(0, 5) = Eventdate2
Eventdate2 = "12:00:00 AM"
ElseIf cell = NameSID Then
cell.Offset(0, 5).Value = "Not Reviewed"
End If
Next cell
End With
End With
End Sub
The expected results is to return either a date, if there is qualifying one, or "Not Reviewed". The code above doesn't return any error messages. It just leaves the EventReview() sub routine mid-loop if there are more than 360 rows, instead of continuing to the second loop to return the results of the loop.
I'm guessing you want to change this
ProcRowCount = Worksheets("Process").Cells(Rows.Count, "a").End(xlUp).Row
to this
ProcRowCount = Worksheets("Process").UsedRange.Rows.Count
because you really want the last row and the former goes to the last row and then hits end up, which might go all the way to row 1.
Similarly with this guy
ScheRow = Worksheets("2025").Cells(Rows.Count, "a").End(xlUp).Row
Side note: when you do this
With ThisWorkbook.Worksheets("Process")
as you've done, then you can (and should) do this
.UsedRange.Rows.Count
Below is my code for the project I am doing, and for some reason I keep on getting an overflow error at the line:
totalAmountWeight = (ActiveWorkbook.Worksheets("Product Info").Cells(p, 8).Value) / (ActiveWorkbook.Worksheets("Product Info").Cells(p, 7).Value)
I am not sure why this error is occurring or how to fix it.
Private Sub Worksheet_Calculate()
Dim target As Range
Set target = Range("Q1")
Dim p As Long
Dim o As Long
Dim r As Long
Dim Length As Single
Dim Width As Single
Dim Height As Single
Dim totalAmountWeight As Double
Dim i As Integer, intValueToFind As Integer
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Worksheets("Product Info")
'lastrow = sheet.Cells(sheet.Rows.Count, "B").End(xlUp).row
lastrow = Range("B" & Rows.Count).End(xlUp).Row
o = 1
r = 1
If Not Intersect(target, Range("Q1")) Is Nothing Then
For p = 2 To lastrow
Length = ActiveWorkbook.Worksheets("Product Info").Cells(p, 2).Value
Width = ActiveWorkbook.Worksheets("Product Info").Cells(p, 3).Value
Height = ActiveWorkbook.Worksheets("Product Info").Cells(p, 4).Value
totalAmountWeight = (ActiveWorkbook.Worksheets("Product Info").Cells(p, 8).Value) / (ActiveWorkbook.Worksheets("Product Info").Cells(p, 7).Value)
ActiveWorkbook.Worksheets("Backend").Range("O1").Value = totalAmountWeight
Call boxes(Length, Width, Height)
Call boxesLast3(Length, Width, Height)
intValueToFind = 0
For i = 2 To 7 ' Revise the 500 to include all of your values
If ActiveWorkbook.Worksheets("Backend").Cells(i, 5).Value = intValueToFind Then
'MsgBox ("Found value on row " & i)
ActiveWorkbook.Worksheets("Backend").Cells(i, 7).Value = 600
ActiveWorkbook.Worksheets("Backend").Cells(i, 8).Value = 400
ActiveWorkbook.Worksheets("Backend").Cells(i, 9).Value = 325
Else
'MsgBox ("Value not found in the range!")
'MsgBox ActiveWorkbook.Worksheets("Backend").Cells(i, 5).Value
End If
Next i
Call LWextra(Height, Length, Width)
Call HWextra(Height, Length, Width)
Call LHextra(Height, Length, Width)
Call HLextra(Height, Length, Width)
Call WLextra(Height, Length, Width)
Call WHextra(Height, Length, Width)
newamount = ActiveWorkbook.Worksheets("Backend").Range("Q1").Value
dimensions = ActiveWorkbook.Worksheets("Backend").Range("K13").Value
ActiveWorkbook.Worksheets("Backend").Cells(o, 26).Value = newamount
o = o + 1
ActiveWorkbook.Worksheets("Backend").Cells(r, 27).Value = dimensions
r = r + 1
Next p
End If
End Sub
My problem is that I am trying to do a series of random numbers let say between 1-10 and these numbers are going to be spread out on like 50 posts and the same random number can only occur max 6 times.
(Edited)
My current code is written that I count the rows with a value divided with 6 to determine how many different random numbers I need. If 58 cells have value i need random numbers between 1-10.
I think the max Rows i need will be 200
Dim i As Integer
Dim a As Integer
a1 = ActiveSheet.UsedRange.Rows.Count
Range("E1") = a1
For i = 1 To a1
MinNumber = 1
MaxNumber = a1 / 6
Range("D1") = MaxNumber
Cells(i, 1).Value = Int((Rnd * (MaxNumber - MinNumber + 1)) + MinNumber)
Next i
This code uses a Dictionary to enter the initial range of required numbers, and then remove them one by one.
Sub Recut()
Dim a As Long
Dim objDic As Object
Dim lngCnt As Long
Dim lngCnt2 As Long
Dim lngCnt3 As Long
Dim lngTot As Long
Dim lngOut As Long
Dim lngNum As Long
lngTot = Application.InputBox("Input number of items to generate", , ActiveSheet.UsedRange.Rows.Count)
Set objDic = CreateObject("scripting.dictionary")
MinNumber = 1
MaxNumber = Int(lngTot / 6) + 1
For lngCnt = 1 To 6
For lngCnt2 = 1 To MaxNumber
lngCnt3 = lngCnt3 + 1
objDic.Add lngCnt2 & "|" & lngCnt, lngCnt3
Next
Next
For lngOut = 1 To a
lngNum = Int(Rnd() * objDic.Count)
Cells(lngOut, 1) = Application.Index(Split(objDic.Keys(lngNum), "|"), 1)
objDic.Remove objDic.Keys(lngNum)
Next
End Sub
The following is a version of your code that will use an array, Note that you said max of 200 rows, so beware if > 200. If same number generated more than 6 times, then will find an alternate. You can remove the Debug.Print' if annoying.
Option Explicit
Sub Random_Numbers()
Dim i As Integer
Dim a As Integer
Dim lLastRow As Long
Dim MinNumber As Long
Dim MaxNumber As Long
Dim lRndNbr As Long
Dim aLimitTo6(200) As Integer
lLastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("E1") = lLastRow
If lLastRow > 200 Then
MsgBox "You are generating numbers for more than 200 rows!! Either increase the Array, or go to 'Plan B'"
Exit Sub
End If
MinNumber = 1
MaxNumber = lLastRow / 6
Range("D1") = MaxNumber
For i = 1 To lLastRow
lRndNbr = Int((Rnd * (MaxNumber - MinNumber + 1)) + MinNumber)
aLimitTo6(lRndNbr) = aLimitTo6(lRndNbr) + 1
If aLimitTo6(lRndNbr) > 6 Then
Debug.Print lRndNbr & " already generated six times!!"
Do ' Try forever?
lRndNbr = Int((Rnd * (MaxNumber - MinNumber + 1)) + MinNumber)
aLimitTo6(lRndNbr) = aLimitTo6(lRndNbr) + 1
If aLimitTo6(lRndNbr) > 6 Then
Debug.Print "Tried once to get another random number (" & lRndNbr & "), but failed!! What do you want to do?"
Else
Cells(i, 1).value = lRndNbr
Exit Do
End If
Loop
Else
Cells(i, 1).value = lRndNbr
End If
Next i
End Sub