Hi
Below is a VBA code I have come across that selects records at random. This does everything I need it to do for the project I have been tasked with, however this code highlights the records that have been selected. How do I change it so that it no longer highlights.
Private Sub cmdPickRandom_Click()
Dim lLastRow As Long
wksHome.AutoFilterMode = False
If Trim(txtRandomCount.Text) = "" Or IsNumeric(txtRandomCount.Text) = False Then
MsgBox "All data showing", vbInformation
Exit Sub
End If
If txtRandomCount.Text <= 0 Then
MsgBox "Invalid sample numbers to be picked", vbInformation
Exit Sub
End If
If CInt(txtRandomCount.Text) <> txtRandomCount.Text Then
MsgBox "Invalid sample numbers to be picked", vbInformation
Exit Sub
End If
lLastRow = wksHome.Range("C" & Rows.Count).End(xlUp).Row
If lLastRow < 19 Then
MsgBox "It seems there is no data in the sheet" & vbNewLine & vbNewLine & "Note: Column C of the Home sheet should not have empty cells", vbInformation
Exit Sub
End If
If txtRandomCount.Text > lLastRow - 18 Then
MsgBox "Number of records to be picked cannot be greater than total records available in the sheet.", vbInformation
Exit Sub
End If
Application.ScreenUpdating = False
'Clear old formulas
wksHome.Range("A:B").ClearContents
'Clear formatting
With wksHome.Range("19:" & Rows.Count).Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Add SN
wksHome.Range("A19").Value = "=A18+1"
'Copy formula
wksHome.Range("A19").Copy wksHome.Range("A19:A" & lLastRow)
'Random formula
wksHome.Range("B19").Value = "=RANDBETWEEN(1," & lLastRow - 18 & ")"
'Copy formula
wksHome.Range("B19").Copy wksHome.Range("B19:B" & lLastRow)
'Calculate Formula
wksHome.Calculate
'Convert to value
wksHome.Range("A19:B" & lLastRow).Value = wksHome.Range("A19:B" & lLastRow).Value
'Sort the data by Random number
wksHome.Sort.SortFields.Clear
wksHome.Sort.SortFields.Add Key:=wksHome.Range("B19:B" & lLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wksHome.Sort
.SetRange wksHome.Range(wksHome.Cells(18, 1), wksHome.Cells(lLastRow, wksHome.Cells.SpecialCells(xlCellTypeLastCell).Column))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Color sample records
wksHome.Range("19:" & CInt(txtRandomCount.Text) + 18).Interior.Color = vbGreen
'Sort the data by SN
wksHome.Sort.SortFields.Clear
wksHome.Sort.SortFields.Add Key:=wksHome.Range("A19:A" & lLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wksHome.Sort
.SetRange wksHome.Range(wksHome.Cells(18, 1), wksHome.Cells(lLastRow, wksHome.Columns.Count))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Clear formulas
wksHome.Range("A:B").ClearContents
wksHome.AutoFilterMode = False
wksHome.Range("18:" & lLastRow).AutoFilter
wksHome.Range(wksHome.Cells(18, 1), wksHome.Cells(lLastRow, wksHome.Columns.Count)).AutoFilter Field:=3, Criteria1:=RGB(0, 255, 0), Operator:=xlFilterCellColor
Application.ScreenUpdating = True
MsgBox "Done", vbInformation
Unload Me
End Sub
I am currently using Office 365
Many thanks
Evie
Bookmarks