Change text value randomly based on category

Hi,

Here's one way in the Command buttn click event

Private Sub Change_Click()
    Dim st As String, ar(), x As Long, y As Long, lRows As Long, c As Long
    st = Sheet2.Range("C3") & Sheet2.Range("C4") & Sheet2.Range("C5")
    lRows = Sheet1.Range("A1").CurrentRegion.Rows.Count - 1

    For x = 1 To lRows
        If Sheet1.Range("G2").Cells(x, 1) = st Then

            ReDim Preserve ar(c)
            ar(c) = x - 1
            c = c + 1
        End If
    Next x

    x = WorksheetFunction.RandBetween(1, c)
    c = 1
    For y = 1 To lRows
        If Sheet1.Range("G2").Cells(y, 1) = st Then
            If c = x Then
                Sheet1.Range("G" & y + 1) = Replace(st, "Male", "Female")
                Exit For
            End If
            c = c + 1
        End If

    Next y


End Sub

Thanks for the rep.