customized function to run in macro and not as formula

G

GoJakie

Board Regular
Joined
Dec 1, 2007
Messages
176
Hello
I have a custom made function (given below) that does a lot of processing and gives an output. Column A has a lot of data that is processed by the function. So far I was using this as a formula but I have observed that when my data in the excel file increases, the file becomes slow as it calculates again and again. I want to calculate everything only once. Can someone please suggest a solution?
Code: 
Function foo(sData As String) As String
  .
  .
  processing happens here
  .
  .
  foo="answer"
End Function
Instead of writing a formula "=foo(A1)" in B1 and dragging it all the way down, appreciate if someone could suggest a macro-based answer.
Thank you.
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
What kind of processing are you doing? Often, processing in a sheet called UDF doesn't work.
About the quickest conversion would be

Code: 
Sub Test()
    Dim oneCell as Range
    Dim i As Long

    With Sheet1.Range("A:A")
        With Range(.Cells(1,1), .Cells(.Rows.Count,1).End(xlUp))
            arrResult = .Value
            For i = 0 to UBound(arrresult,1)
                arrResult(i, 1) = foo(CStr(arrResult(i, 1)))
            Next i
            .Offset(0,1).Value = arrResult
        End With
    End With
End Sub

I'm also curious if the processing has to be done for each different string.
 
Upvote 0
Thanks. the function finds redirected url through http requests. I tried your code but it gives compile error Type mismatch on "CStr"
 
Upvote 0
When it errors, what does the immediate window give for TypeName(arrResult(i,1)).
Also that sub assumes that there is data on more than one row of column A.
 
Upvote 0
I didnt get you when you said "what does the immediate window give" It errrors compile error Type mismatch and "CStr" is highlighted in blue behind the error window.
Yes column A is filled with data
EDIT- I have foo function and test code both in a new module
 
Upvote 0
This should work
Code: 
Sub Test()
    Dim oneCell As Range
    Dim i As Long, arrResult() As String

    With Sheet1.Range("A:A")
        With Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
            ReDim arrResult(1 To .Rows.Count, 1 To 1)
            For i = 1 To UBound(arrResult, 1)
                MsgBox .Cells(i, 1).Value
                arrResult(i, 1) = foo(CStr(.Cells(i, 1).Value))
            Next i
            .Offset(0, 1).Value = arrResult
        End With
    End With
End Sub
 
Upvote 0
Again same error. This is what I did:
I inserted a new module, kept your test2 sub on top and underneath I kept the function foo. Is this correct? do i need to save the function at a different place?
by the way these are the three functions i am trying to run in the macro (it should not matter but still....) I have all my 5k+ links n column A

Code: 
Function foo(cell As Range, _
Optional default_value As Variant)
'Lists the Hyperlink Address for a Given Cell
'If cell does not contain a hyperlink, return default_value
If (cell.Range("A1").Hyperlinks.Count <> 1) Then
foo = default_value
Else
foo = cell.Range("A1").Hyperlinks(1).Address & "#" & cell.Range("A1").Hyperlinks(1).SubAddress
End If
End Function

Code: 
Function FinalURL(sURL As String) As String
  ' shg 2009, but surely derived from something similar
  ' Requires a reference to Microsoft WinHTTP Services

  Static oHTTP As WinHttpRequest

  If oHTTP Is Nothing Then Set oHTTP = New WinHttpRequest

  On Error GoTo Oops
  With oHTTP
    .Open "GET", sURL
    .Send

    Select Case .Status
      Case 200: FinalURL = .Option(1)
      Case 403: FinalURL = "Forbidden"
      Case 404: FinalURL = "Not Found"
      Case 410: FinalURL = "Gone"
      Case 503: FinalURL = "Service Unavailable"
      Case Else: FinalURL = False
    End Select
    Exit Function
  End With

Oops:
  FinalURL = False
End Function
Thanks
 
Last edited:
Upvote 0
I am trying since long and with little bit of research i constructed the below code but it gives run-time error 424 Object required
Code: 
Sub test3()
Dim i As Integer
Dim LastCell As Integer
LastCell = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastCell
  Range("B" & i).Value = foo(Range("A" & i).Value)
Next i
End Sub
 
Upvote 0
The foo in Post#7 requries a range as an argument. (The OP foo required a string).
Removing the .Value from post#8 should fix that.
 
Upvote 0
Thank you so much. Issue resolved. I got the post#8 rectified from your .Value removal tip. However, still struggling to get it to work by your method.
If you see post #7, there are two functions one requires range (Function foo(cell As Range,) and other requires string (Function FinalURL(sURL As String) As String) If I want to go with your code what changes will I need to make?
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
How to sum a row of data with some cells containing an extra character
2
Replies
10
Views
690
Fluff
Fluff
T
  • Question
Excel Table Refresh Speed
Replies
0
Views
336
Tyler Durdin
T
E
  • Question
Forecasting with VBA or Power Pivot in Excel
Replies
0
Views
376
Emilio30
E
S
  • Question
Updating "Templates"
Replies
0
Views
678
Skiier89
S
G
  • Solved
VBA to allow grouping +- after reopening of the sheet
Replies
7
Views
756
Greenbehindthecells
G

Forum statistics

Threads
1,214,873
Messages
6,122,029
Members
449,061
Latest member
TheRealJoaquin

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top