Call function and apply it for each cell

Last Edited By Krjb Donovan
Last Updated: Mar 05, 2014 09:17 PM GMT

Question

I tried to write the below code to call a new created function [Function FIFO(ProductCode As Range, UnitsSold As Range) As Currency], and to be applied for each row of Column "L" in sheet2 but it does not apply would you mind correcting it, please?


Sub EndingInventory() Dim cell As Range, r1 As Range, r As Range Dim rem As Variant Dim FIFO1 As Long Set r = Sheet2.Range("L2:L12") For Each cell In r

 Call FIFO(Cells(cell.Row, "H").Text, Cells(cell.Row, "I").Value)
 rem = FIFO
If Not IsError(res) Then
   If IsNumeric(res) Then
      rem = rem
      cell.Value = rem
   Else
      cell = rem
   End If
Else
   cell.ClearContents
End If

Next End Sub

Many Thanks Lurenzo

Answer

Lurenzo,

' Dummy FIFO Function to demonstrate assigning a value to the function name ' the function should return a Text Value, a Numeric Value or an Error. Text ' or number is decided by the values in columns H and I in rows 2 to 12.

Public Function FIFO(ProductCode As Range, UnitsSold As Range) Dim d As Single, ans As Variant d = Rnd() If d < 0.3 Then

 ans = ProductCode.Value

ElseIf d < 0.6 Then

 ans = UnitsSold.Value

Else

 ans = CVErr(xlErrNA)

End If FIFO = ans End Function


Sub EndingInventory() Dim cell As Range, r As Range Dim res As Variant ' rem is a VBA keyfor Remark. You can't us it as a variable

 ' I have changed it to "res"

' if you qualify Range with Sheet2, then you should probably also qualify ' Cells in the arguments to FIFO Set r = Sheet2.Range("L2:L12") For Each cell In r

' your function declaration is expecting range references as arguments
res = FIFO(Sheet2.Cells(cell.Row, "H"), Sheet2.Cells(cell.Row, "I"))

If Not IsError(res) Then

  If IsNumeric(res) Then
     cell.Value = res
  Else
     ' I just added the string "Product Code: " to make the output look different
     ' when I tested the function.  You can me this line whatever it should be.
     cell.Value = "Product Code: " & res
  End If

Else

  cell.ClearContents

End If Next End Sub

These were tested and worked as I expected. Hope that helps.

Advertisement

©2017 eLuminary LLC. All rights reserved.