joes
joes

Reputation: 31

Calling VBA custom Function in the main Subroutine

I have two functions that both determine the output depending on the value in a cell. The outcome is Column N should have a combined output of function mBlineCTG + findShpc. They separately work, I would like to call them on the main function that way I don't have to run both routines separately. Am open to help including the logic behind

Option Compare Text
Sub Main()
 M_xx
 f_xxx
 Cells(i, 14).Value = M_xx + f_xxx
 Range("Q1").Value = "xxx_xxxx"
End Sub

Public Function M_xxx()
 Dim LastRow As Long
 LastRow = Cells(Rows.Count, 1).End(xlUp).Row

 Dim  s_Cxx
 Dim i As Integer

For i = 2 To LastRow
Select Case UCase(Left(Cells(i, 10).Value, 1))
    Case "s"
        s_Cxx = "D"
    Case "0"
         s_Cxx= "SD"
    Case "1", "R", "E", "F"
        Select Case UCase(Left(Cells(i, 13).Value, 2))
          Case "13"
             s_Cxx = "SB"
            Case Else
             s_Cxx = "SS"
        End Select
    Case "I"
      s_Cxx = "IS"
    Case "2", "15"
         s_Cxx = "BB"
    Case "3"
         s_Cxx = "SF"
    Case Else
         s_Cxx = ""
 End Select

    Next i
End Function

Public Function f_xxxx()
 'declare variables
 Dim LastRow As Long

 LastRow = Cells(Rows.Count, 1).End(xlUp).Row
 'Dim ThisCont
 'ThisCont = Range("E2").Value
  Dim S_xxx2
  'loop thru' rows 
  Dim i As Integer

  For i = 2 To LastRow
  Select Case UCase(Left(Cells(i, 5).Value, 1))
   'Select Case ThisCont
        Case "A"
           S_xxx2 = "big-base-Post-01 0 01 Cee-xx-04"
        Case "X"
           S_xxx2 = "small-shelf-Post-01 0 01 Cee-xx-01"
        Case Else
           S_xxx2= "big-drawer-Post-01 0 01 Cee-xx-06"
  End Select
   'Cells(i, 14).Value = S_xxx2
 Next i
End Function

Upvotes: 1

Views: 975

Answers (1)

David Zemens
David Zemens

Reputation: 53623

I think you have some confusion, as you're calling both functions twice.

The first call to each is redundant as it does not return any value to the main procedure. The second call is an error since i is undefined in the scope of Main procedure.

Option Compare Text
Sub Main()
 mBlineCTG   '<-- calls the mBlineCTG function but does not return any value
 findShpc    '<-- calls the findShpc function but does not return any value
 Cells(i, 14).Value = mBlineCTG + findShpc  'This line is an error because "i" _
                                             is undefined, but this would writes the _
                                             sum of two functions to Column N/Row i, _
                                             if "i" is an integer >= 1
 Range("N1").Value = "SHP_SRC"  '<-- overwrites the value in Range("N1")
End Sub

I think this is what you need:

Option Compare Text
Sub Main()
 Range("N1").Value = mBlineCTG & findShpc  '<-- concatenates mBlineCTG and findShpc in to range("N1")
End Sub

Also, I note that neither of your functions has a return value of any sort, so this actually won't write anything in to the N1 cell... You're going to need to elaborate more on what is the expected output.

I think this might take care of it, do the loop in the main function (instead of redundant loop in the called functions):

Option Compare Text
Option Explicit
Sub Main()
Dim FinalRow As Long
Dim i As Long

FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
    Range("N2").Cells(i).Value = mBlineCTG(i) & findShpc(i) '<-- concatenates mBlineCTG and findShpc in to range("N1")
Next
End Sub


Public Function mBlineCTG(i As Long)
    Dim ThisCont
    Dim shpCt As String

    Select Case UCase(Left(Cells(i, 13).Value, 1))
        Case "D"
            shpCt = "D"
        Case "0"
            shpCt = "V"
        Case "1", "R", "E", "F"
            Select Case UCase(Left(Cells(i, 13).Value, 2))
              Case "13"
                shpCt = "B"
                Case Else
                shpCt = "S"
            End Select
        Case "I"
            shpCt = "I"
        Case "2", "15"
            shpCt = "B"
        Case "3"
            shpCt = "F"
        Case Else
            shpCt = ""
     End Select

     '#### RETURN THE VALUE TO CALLING PROCEDURE:
     mBlineCTG = shpCt

End Function

Public Function findShpc(i As Long)
  Dim SHPcT2 As String
  Select Case UCase(Left(Cells(i, 5).Value, 1))
   'Select Case ThisCont
        Case "A"
           SHPcT2 = "L-BM-PS-01 0 01 CC-LG-01"
        Case "X"
           SHPcT2 = "X-BM-PS-01 0 01 CC-XX-01"
        Case Else
           SHPcT2 = "S-SH-PS-01 0 01 CC-SM-01"
  End Select
  '#### RETURN THE VALUE TO CALLING PROCEDURE:
  findShpc = SHPcT2
End Function

Upvotes: 1

Related Questions