Create BVA TCs

main.vb

Sub Create_TCs()
    'Extract Value From Dashboard
    Dim min, max As Integer
    Dim given, when As String
    min = Worksheets("Dashboard").Range("C2").Value
    max = Worksheets("Dashboard").Range("C3").Value
    given = Worksheets("Dashboard").Range("C4").Value
    when = Worksheets("Dashboard").Range("C5").Value
    
    'Filter min and max
    Dim minmax() As Integer
    minmax = FilterMinMax(min, max)
    min = minmax(1)
    max = minmax(2)
    Worksheets("Dashboard").Range("C2").Value = min
    Worksheets("Dashboard").Range("C3").Value = max
    
    'Clear Contents
    Worksheets("Result").Range("A2:D999").ClearContents
    
    'Calculate TCs
    Dim tc() As String
    tc = BVAStrings(min, max)
    
    'Display on the Result
    For i = 1 To UBound(tc)
        Worksheets("Result").Range("A" & i + 1).Value = i
        Worksheets("Result").Range("B" & i + 1).Value = given
        Worksheets("Result").Range("C" & i + 1).Value = when & " '" & tc(i) & "'"
        Worksheets("Result").Range("D" & i + 1).Value = OKNG(min, max, tc(i))
    Next i
    
    MsgBox ("Look 'Result' Sheet")
End Sub

Function BVAStrings(min, max)
    Dim arr() As String
    Dim i As Integer
    i = 1
    If min > 0 Then
        ReDim arr(6)
        arr(i) = StringOfTheLength(min - 1)
        i = i + 1
    Else
        ReDim arr(5)
    End If
    arr(i) = StringOfTheLength(min)
    i = i + 1
    arr(i) = StringOfTheLength(min + 1)
    i = i + 1
    arr(i) = StringOfTheLength(max - 1)
    i = i + 1
    arr(i) = StringOfTheLength(max)
    i = i + 1
    arr(i) = StringOfTheLength(max + 1)
    BVAStrings = ArrayUnique(arr)
End Function

Function StringOfTheLength(length)
    Const a As String = "a"
    For i = 1 To length
        StringOfTheLength = StringOfTheLength & a
    Next i
End Function

Function ArrayUnique(arr)
    Dim coll As New Collection
    Dim i As Long

    On Error Resume Next
    For i = 1 To UBound(arr)
        coll.Add arr(i), arr(i)
    Next i

    ReDim arr(coll.Count)

    For i = 1 To coll.Count
        arr(i) = coll(i)
    Next i
    ArrayUnique = arr

End Function

Function OKNG(min, max, str)
    Dim rThen As String
    rThen = "OK"
    If Len(str) < min Or Len(str) > max Then
        rThen = "NG"
    End If
    OKNG = rThen
End Function

Function FilterMinMax(min, max)
    Dim arr(2) As Integer
    If min < 0 Then
        min = 0
    End If
    If max < 0 Then
        max = 0
    End If
    arr(1) = WorksheetFunction.min(min, max)
    arr(2) = WorksheetFunction.max(min, max)
    FilterMinMax = arr
End Function

test.vb

Option Explicit
Option Private Module
    
'@TestModule
'@Folder("Tests")
    
Private Assert As Object
Private Fakes As Object

'@ModuleInitialize
Private Sub ModuleInitialize()
    'this method runs once per module.
    Set Assert = CreateObject("Rubberduck.AssertClass")
    Set Fakes = CreateObject("Rubberduck.FakesProvider")
End Sub

'@ModuleCleanup
Private Sub ModuleCleanup()
    'this method runs once per module.
    Set Assert = Nothing
    Set Fakes = Nothing
End Sub

'@TestInitialize
Private Sub TestInitialize()
    'This method runs before every test in the module..
End Sub

'@TestCleanup
Private Sub TestCleanup()
    'this method runs after every test in the module.
End Sub

'@TestMethod("BVAStrings")
Private Sub BVAStringsOK()
    On Error GoTo TestFail
    
    'Arrange:
    
    'Act:
    Dim arr() As String
    Dim length As Integer
        
    arr = BVAStrings(1, 10)
    length = UBound(arr)
    
    'Assert:
    Assert.AreEqual length, 6
    Assert.AreEqual arr(1), ""
    Assert.AreEqual arr(2), "a"
    Assert.AreEqual arr(3), "aa"
    Assert.AreEqual arr(4), "aaaaaaaaa"
    Assert.AreEqual arr(5), "aaaaaaaaaa"
    Assert.AreEqual arr(6), "aaaaaaaaaaa"
        
    'Act:
    arr = BVAStrings(0, 10)
    length = UBound(arr)
        
    'Assert:
    Assert.AreEqual length, 5
    Assert.AreEqual arr(1), ""
    Assert.AreEqual arr(2), "a"
    Assert.AreEqual arr(3), "aaaaaaaaa"
    Assert.AreEqual arr(4), "aaaaaaaaaa"
    Assert.AreEqual arr(5), "aaaaaaaaaaa"
        
    'Act:
    arr = BVAStrings(2, 10)
    length = UBound(arr)
        
    'Assert:
    Assert.AreEqual length, 6
    Assert.AreEqual arr(1), "a"
    Assert.AreEqual arr(2), "aa"
    Assert.AreEqual arr(3), "aaa"
    Assert.AreEqual arr(4), "aaaaaaaaa"
    Assert.AreEqual arr(5), "aaaaaaaaaa"
    Assert.AreEqual arr(6), "aaaaaaaaaaa"
TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod("StringOfTheLength")
Private Sub StringOfTheLengthOK()
    On Error GoTo TestFail
    
    'Arrange:
    
    'Act:
    Dim msg As String
    msg = StringOfTheLength(10)
    
    'Assert:
    Assert.AreEqual "aaaaaaaaaa", msg
        
    'Act:
    msg = StringOfTheLength(1)
    
    'Assert:
    Assert.AreEqual "a", msg
    'Act:
    msg = StringOfTheLength(0)
    
    'Assert:
    Assert.AreEqual "", msg
    
    
TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod("ArrayUnique")
Private Sub ArrayUniquehOK()
    On Error GoTo TestFail
    
    'Arrange:
    
    'Act:
    Dim arr() As String
    Dim length As Integer
    ReDim arr(4)
        
    arr(1) = "a"
    arr(2) = "aa"
    arr(3) = "a"
    arr(4) = "aa"
        
    arr = ArrayUnique(arr)
    length = UBound(arr)
        
    'Assert
    Assert.AreEqual length, 2
    Assert.AreEqual arr(1), "a"
    Assert.AreEqual arr(2), "aa"
        
    ReDim arr(6)
        
    'Act:
    arr(1) = "a"
    arr(2) = "aa"
    arr(3) = "aaa"
    arr(4) = "aaaaaaaaa"
    arr(5) = "aaaaaaaaaa"
    arr(6) = "aaaaaaaaaaa"
    arr = ArrayUnique(arr)
    length = UBound(arr)
        
    Assert.AreEqual length, 6
    Assert.AreEqual arr(1), "a"
    Assert.AreEqual arr(2), "aa"
    Assert.AreEqual arr(3), "aaa"
    Assert.AreEqual arr(4), "aaaaaaaaa"
    Assert.AreEqual arr(5), "aaaaaaaaaa"
    Assert.AreEqual arr(6), "aaaaaaaaaaa"
    
TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod("OKNG")
Private Sub OKNGOK()
    On Error GoTo TestFail
    
    'Arrange:
    
    'Act:
       
        
    'Assert
    Assert.AreEqual OKNG(1, 10, ""), "NG"
    Assert.AreEqual OKNG(1, 10, "a"), "OK"
    Assert.AreEqual OKNG(1, 10, "aa"), "OK"
    Assert.AreEqual OKNG(1, 10, "aaaaaaaaa"), "OK"
    Assert.AreEqual OKNG(1, 10, "aaaaaaaaaa"), "OK"
    Assert.AreEqual OKNG(1, 10, "aaaaaaaaaaa"), "NG"
    
TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod("FilterMinMax")
Private Sub FilterMinMaxOK()
    On Error GoTo TestFail
    
    'Arrange:
    
    'Act:
    Dim arr() As Integer
    Dim length As Integer
    arr = FilterMinMax(1, 2)
    length = UBound(arr)
        
    'Assert
    Assert.AreEqual length, 2
    Assert.AreEqual 1, arr(1)
    Assert.AreEqual 2, arr(2)
        
    'Act:
    arr = FilterMinMax(2, 1)
    length = UBound(arr)
        
    'Assert
    Assert.AreEqual length, 2
    Assert.AreEqual 1, arr(1)
    Assert.AreEqual 2, arr(2)
        
    'Act:
    arr = FilterMinMax(-1, 2)
    length = UBound(arr)
        
    'Assert
    Assert.AreEqual length, 2
    Assert.AreEqual 0, arr(1)
    Assert.AreEqual 2, arr(2)
    
TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub