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,

 

[Micron]

The only difference between a function and a sub is that a function can return a value whereas a sub cannot. AFAIK, a function is the only type of procedure that can be called by ribbon or command bar or used as a controlsource reference or to return a value to a cell, but that does not alter how it performs. If you 'messed it up' by converting it to a function, then you must have altered something else as well. All it takes to convert Sub Group_Constraint() to a function is to retype it as Function Group_Constraint() and change End Sub to End Function. Any other use of the word sub/function within has to be edited as well (e.g. Exit Sub).

 

[STA]

Thank you for your answer Micron.

Unfortunately this is what i did with no luck. I did change sub to function, then at the end the i assigned a return value to the function depending on the outcome but what i receive in excel is a #Value!. Here i have to mention that while debuging in the intermidiary window i receive the correct outcome. Honestly have no idea why excel dows not return the correct value.

 

[Micron]

I have a feeling that it means the value being returned is of the wrong data type for the cell/range. Check the format of the cell(s) against the data type your function is returning and maybe post those details?

 

[Fluff]

I cannot even get your code to run. What is the range it's meant to be working on?
Also it is writing to various cells on the sheet, which a UDF cannot do.

 

[STA]

I cannot even get your code to run. What is the range it's meant to be working on?
Also it is writing to various cells on the sheet, which a UDF cannot do.

Hi Fluff,

Thank you for the responce. I am adding the excel file that i write the code for. You see in order to have an outcome i need some calculations to be made first and that is why i use other cells. So if i understand correctly all calculations should be made inside the vba( lets say in the air) and the pass in my excel. I also share the function i tried to work with. Note this is for a specific task i want to do thus i dont actually mind if it will work in other files. This is something that will bother me later.

This is the function :

Public Function outcome(rng As Range) As Integer

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

'Testing where A has the majority
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

         outcome = 1
       
        
        sh1.Range("N1", sh1.Range("N1").End(xlToRight)).EntireColumn.Delete

Else


        outcome = 0
        
        sh1.Range("N1", sh1.Range("N1").End(xlToRight)).EntireColumn.Delete

End If

End Function

Here i defined outcome as 1 if true and 0 if false.

Thank you

group test.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	Group	A	B	C	D	E	F	G	H	I	J
2	A	0	0.5	0	0.5	0	0.28	0	0	0	0
3	B	0	0	0	0	0	0	0	0.44	0	0
4	C	0	0	0	0	0	0	0.5	0	0	0
5	D	0	0	0	0	0	0.16	0	0.06	0	0
6	E	0	0	0	0	0	0.06	0	0	0	0
7	F	0	0	0	0	0	0	0	0	0.1	0.37
8	G	0	0	0	0	0	0	0	0	0	0
9	H	0	0	0.5	0	0.5	0	0	0	0	0.2
10	I	0	0	0	0	0	0	0	0	0	0
11	J	0	0.5	0.5	0.5	0.5	0.5	0.5	0.5	0.5	0.5
12
13
14	#VALUE!
Sheet1

Cell Formulas
Range	Formula
A14	A14	=outcome(A1:K11)

 

[STA]

In previous line Set rng = sh1.Range("A1", sh1.Range("A1").End(xlToRight).End(xlDown)) should not exist.

I have it as a comment in my code..

 

[Fluff]

So if i understand correctly all calculations should be made inside the vba( lets say in the air) and the pass in my excel

That is correct.
But you will need to explain exactly what you are trying to do, rather than relying on people to try & reverse engineer your code.

 

[STA]

That is correct.
But you will need to explain exactly what you are trying to do, rather than relying on people to try & reverse engineer your code.

Thank you again. I am trying to check if columns sum are greateror equal to 0.5 but only if the sum comes through A

 

[STA]

That is correct.
But you will need to explain exactly what you are trying to do, rather than relying on people to try & reverse engineer your code.

I was able to convert it in a function by removing all excel calculation from the code.

Thank you Fluff for the advice