Convert Sub to Function

[STA]

Hi All,

New member here and hope you can help.

I am entry lvl in VBA (started learning 2 months ago) and trying to convert a sub procedure into a function but i have no idea how. Whatever i have done i keep having a #value! as answer in my formula.

Below is the code :

Option Explicit

Sub Group_Constraint()

Dim sh1 As Worksheet
Dim arr1 As Variant
Dim Check2 As New Collection
Dim i As Integer, k As Integer
Dim j As Integer, y As Integer
Dim rng As Range

Set sh1 = Sheets(3)

Set rng = sh1.Range("A1", sh1.Range("A1").End(xlToRight).End(xlDown))

arr1 = rng

For j = 1 To 2

    For i = LBound(arr1, 1) To UBound(arr1, 1)

        sh1.Range("N1").Offset(j - 1, i - 1) = arr1(j, i)

    Next i

Next j

For j = 2 To 2

    For i = 2 To UBound(arr1, 1)

        If Application.WorksheetFunction.IsNumber(arr1(j, i)) = True Then
       
            If arr1(j, i) >= 0.5 Then

                 For k = 1 To UBound(arr1, 1)

                    sh1.Range("N1").Offset(0, k - 1).End(xlDown).Offset(1) = arr1(i, k)

                Next k
       
            End If
       
        End If

    Next i

Next j

i = 1

For i = LBound(arr1, 1) To UBound(arr1, 1)

    If Application.WorksheetFunction.CountIf(sh1.Range("N1", sh1.Range("N1").End(xlDown)), sh1.Range("N1").Offset(0, i - 1)) = 0 Then
       
        If Application.WorksheetFunction.Sum(sh1.Range(sh1.Range("N1").Offset(0, i - 1), sh1.Range("N1").Offset(0, i - 1).End(xlDown))) >= 0.5 Then
   
            For k = 1 To UBound(arr1, 1)
       
                sh1.Range("N1").Offset(0, k - 1).End(xlDown).Offset(1) = arr1(i, k)
       
            Next k
           
        Else
           
            Check2.Add i, sh1.Range("N1").Offset(0, i - 1)
            GoTo NextIteration
       
        End If
       
    Else
   
        GoTo NextIteration
       
    End If

NextIteration:

Next i

k = 1
j = 1
i = 1

If IsEmpty(Check2) Then

Else

    Do While Check2.Count <> y

     y = Check2.Count
    
Above:
    
        For i = 1 To Check2.Count

                If i > Check2.Count Then
               
                  GoTo Above
               
                Else
           
                        If Application.WorksheetFunction.Sum(sh1.Range(sh1.Range("N1").Offset(0, Check2(i) - 1), sh1.Range("N1").Offset(0, Check2(i) - 1).End(xlDown))) >= 0.5 Then
                   
                                For k = 1 To UBound(arr1, 1)
                   
                                    sh1.Range("N1").Offset(0, k - 1).End(xlDown).Offset(1) = arr1(Check2(i), k)
                   
                                Next k
                               
                                Check2.Remove (sh1.Range("N1").Offset(0, Check2(i) - 1))
                               
                        End If
               
                End If
       
        Next i
   
    Loop
   
End If

If sh1.Range("N2", sh1.Range("N2").End(xlDown)).Count = sh1.Range("O1", sh1.Range("O1").End(xlToRight)).Count Then

        Cells(14, 1) = "TRUE"
       
        sh1.Range("N1", sh1.Range("N1").End(xlToRight)).EntireColumn.Delete

Else


        Cells(14, 1) = "FALSE"
        sh1.Range("N1", sh1.Range("N1").End(xlToRight)).EntireColumn.Delete

End If

End Sub

What i want to do is being able to have a formula , put inside the range i need and then return a true or false as an answer. As a sub is working fine but as a fuction everything goes wrong.

Happy to hear your thoughts

Regards,

 

[Fluff]

Glad you sorted it & thanks for the feedback.