Thursday, June 11, 2020

VBA Function to Generate Dummy data for numbers, string and date values

Hi guys,

If you need to generate any random dummy data for string/alphanumeric/date/numbers(2 digit/3 digit) then below logic might help you.

provide your sDatatype in below select case.

  Select Case sDataType
            Case Is = "Alphabets"
                dtRndData = UCase(Cnst) & Vowel & Cnst & Vowel & Cnst
            Case Is = "Alphanumeric"
                DLocation = UCase(Cnst) & Vowel & Cnst & Vowel & Cnst
                dtRndData = Tens() & " " & DLocation
            Case Is = "Date"
                dtRndData = GetRndDate(#12/1/1965#, #5/31/2020#)
            Case Is = "Numbers"
                dtRndData = Tens()
        End Select

Function LName()
    Dim i As Long, Tmp As String
    LName = UCase(Cnst) & Vowel & Cnst & Vowel & Cnst
End Function

Function Vowel()
      Dim V
      V = Array("a", "e", "i", "o", "u")
      Vowel = V(Int((5 * Rnd)))
End Function
   
Function Cnst()
    Dim C
    C = Array("b", "c", "d", "f", "g", "h", "j", "k", "l", "m", _
                "n", "p", "q", "r", "s", "t", "v", "w", "x", "y", "z")
    Cnst = C(Int((21 * Rnd)))
End Function
Function Tens()
    Tens = Int(100 * Rnd)
End Function

Function Hundreds()
    Hundreds = Int(1000 * Rnd)
End Function

Function GetRndDate(dtStartDate As Date, dtEndDate As Date) As Date
    On Error GoTo Error_Handler
    Dim dtTmp                 As Date

    'Swap the dates if dtStartDate is after dtEndDate
    If dtStartDate > dtEndDate Then
        dtTmp = dtStartDate
        dtStartDate = dtEndDate
        dtEndDate = dtTmp
    End If

    Randomize
    GetRndDate = DateAdd("d", Int((DateDiff("d", dtStartDate, dtEndDate) + 1) * Rnd), dtStartDate)

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetRndDate" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

No comments:

Post a Comment