Random Number Generator

[Sharid]

Hi

I’m looking for a random number generator. If the customer has not supplied a Tax number/National insurance in Column A then a random number will be placed once the VBA is run, it will also highlight the whole row, in red.

There can be no duplicates

Its will be as TEMP12345678

If a tax number has been provided it will skip that cell in column A an move onto the next blank cell, until it gets to last row with data in it.


Column A

1 777-55-8888
2 777-55-8889
3 TEMP12345678
4 777-55-8890
5 TEMP23456789
6 777-55-8891
7 777-55-8892

In the example above Cells is rows 3 and 5 were empty so when the code was run a temp number was placed. I have looked at a few random number generators none do what I need.

[JoeMo]

Does this do what you want?

Sub RandIfEmpty()
Const StartNum = 10000000 'Set the lowest number
Const EndNum = 99999999   'Set the highest number
Dim R As Range, c As Range, d As Object, X As String
On Error Resume Next
Set R = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If R Is Nothing Then Exit Sub
Set d = CreateObject("Scripting.dictionary")
Application.ScreenUpdating = False
For Each c In R
Again:
    X = "TEMP" & Int((EndNum - StartNum + 1) * Rnd + StartNum)
    If Not d.exists(X) Then
        d.Add X, d.Count + 1
        With c
            .Value = X
            .EntireRow.Font.Color = vbRed
        End With
    Else
        GoTo Again
    End If
Next c
Columns("A").AutoFit
Application.ScreenUpdating = True
End Sub

[wideboydixon]

Public Sub FillInBlankNI()

Dim lastRow As Long
Dim thisRow As Long

lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For thisRow = 1 To lastRow
    If Cells(thisRow, "A").Value = "" Then
        Cells(thisRow, "A").Value = "TEMP" & Format$(WorksheetFunction.RandBetween(0, 99999999), "00000000")
        Cells(thisRow, "A").EntireRow.Font.Color = vbRed
    End If
Next thisRow

End Sub

WBD

[Rick Rothstein]

Here is another macro that should work...

Sub FillBlanksWithRandomTempNumber()
  Dim RandNum As Long, Cell As Range, Blanks As Range, Nums As String
  For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlBlanks)
    Do
      RandNum = Application.RandBetween(10000000, 99999999)
    Loop While InStr(" " & Nums & " ", " " & RandNum & " ")
    Nums = Nums & " " & RandNum
    Cell.Value = "TEMP" & RandNum
    Cell.Font.Color = vbRed
  Next
End Sub

[Rick Rothstein]

Public Sub FillInBlankNI()

Dim lastRow As Long
Dim thisRow As Long

lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For thisRow = 1 To lastRow
    If Cells(thisRow, "A").Value = "" Then
        Cells(thisRow, "A").Value = "TEMP" & Format$(WorksheetFunction.RandBetween(0, 99999999), "00000000")
        Cells(thisRow, "A").EntireRow.Font.Color = vbRed
    End If
Next thisRow

End Sub

While admittedly highly unlikely, your code would permit duplicate random numbers to be assigned.

[Sharid]

Thanks both of you, saved my life

[wideboydixon]

While admittedly highly unlikely, your code would permit duplicate random numbers to be assigned.

I like to live dangerously.

WBD

[Rick Rothstein]

Thanks both of you, saved my life

It is hard to tell from the timestamp on your message whether you saw what I posted in Messages #3 and #4 yet. If you haven't, I would like to draw your attention to them.

[wideboydixon]

It is hard to tell from the timestamp on your message whether you saw what I posted in Messages #3 and #4 yet. If you haven't, I would like to draw your attention to them.

You missed the "entire row" requirement for the cell colour I think.

Cell.EntireRow.Font.Color = vbRed

WBD

[Rick Rothstein]

You missed the "entire row" requirement for the cell colour I think.

Cell.EntireRow.Font.Color = vbRed

Yes I did. Thanks for point that out. To make it easier for the OP, here is the corrected code...

Sub FillBlanksWithRandomTempNumber()
  Dim RandNum As Long, Cell As Range, Blanks As Range, Nums As String
  For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlBlanks)
    Do
      RandNum = Application.RandBetween(10000000, 99999999)
    Loop While InStr(" " & Nums & " ", " " & RandNum & " ")
    Nums = Nums & " " & RandNum
    Cell.Value = "TEMP" & RandNum
    Cell.EntireRow.Font.Color = vbRed
  Next
End Sub