Custom Function in XLSX?

WTHamIdoing

New Member
Joined
Aug 5, 2023
Messages
10
Office Version
  1. 365
Platform
  1. Windows
I have a workbook that has a custom function in it. A custom function was the only way to make xcel give back the data needed. I want to use the workbook as a template to merge date from our CRM into. Unfortuntately FormStack (The app that does the merge from our CRM to Excel) does not support macro enabled workbooks. Anyone have an idea how I can make the resulting spreadsheet (*.xlsx) still utilize the function?
Below is the bulk of the function. THere are two other small pieces but I dont think they matter to my question.

Function CustomSummary(init_tab As String, end_tab As String, keyword As String, columnToSearch As String, columnToReturn As String) As Variant

Dim ws As Worksheet
Dim startFound As Boolean
Dim endFound As Boolean
Dim sumResult As Double

sumResult = 0
startFound = False
endFound = False

Dim initTabExists As Boolean
Dim endTabExists As Boolean
initTabExists = False
endTabExists = False

For Each ws In ThisWorkbook.Worksheets

If ws.Name = init_tab Then
initTabExists = True
startFound = True

If endFound Then
CustomSummary = "End tab '" & end_tab & "' found before Init tab '" & init_tab & "'."
Exit Function
End If

End If

If startFound And ws.Name <> init_tab And ws.Name <> end_tab Then

Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, columnToSearch).End(xlUp).Row

Dim rng As Range
Set rng = ws.Range(columnToSearch & "1:" & columnToSearch & lastRow)

Dim cell As Range
Dim buffer_val As Variant

For Each cell In rng

If cell.Value = keyword Then

Set buffer_val = ws.Range(columnToReturn & cell.Row)

If IsNumeric(buffer_val) Then

sumResult = sumResult + buffer_val.Value

End If

End If

Next cell

End If

If ws.Name = end_tab Then

endTabExists = True
endFound = True

If Not startFound Then
CustomSummary = "Init tab '" & init_tab & "' not found."
Exit Function
End If

Exit For

End If

Next ws

If Not initTabExists Then
CustomSummary = "Init tab '" & init_tab & "' not found."
Exit Function
End If

If Not endTabExists Then
CustomSummary = "End tab '" & end_tab & "' not found."
Exit Function
End If


CustomSummary = sumResult


End Function
 
Can you cut an paste the actual use of the function in your worksheet? The first two arguments are the names of Worksheets. Therefore, "Deliverables" should be one of those arguments, but I need to know which one so I can try to determine how/where the function is not working
I think the logic of the CustomSummary function could be improved. The main loop walks through the sheets in the Workbook looking for the value passed as the init_tab argument in your example the sheet named "Custom Summary", and end_tab your example "Deliverables". However, the main loop looks like the following

For Each ws In ThisWorkbook.Worksheets
'vba code here
Next ws

If the loop finishes and it has not found the end_tab you will see the error you're seeing.


Should/Does the code do anything with sheets other than the two that you specify? If the code looked for "Customer Summary" and "Deliverables" only rather that looping through all of them this could make the function work as desired. If the either one of the two specified sheets do not exist - exit the function. But without the loop. Should the function ever sum more than the two sheets specified as arguments?

It appears the function primarily sums value in the ColumnToReturn arg, when the keyword is found. I think the function could be cleaned up.

From your example the summed value should come from the two sheets named "TK Opprotunity" and "Machine 1" if the keyword "TOTAL MACHINERY" is found.
 
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
I think the logic of the CustomSummary function could be improved. The main loop walks through the sheets in the Workbook looking for the value passed as the init_tab argument in your example the sheet named "Custom Summary", and end_tab your example "Deliverables". However, the main loop looks like the following

For Each ws In ThisWorkbook.Worksheets
'vba code here
Next ws

If the loop finishes and it has not found the end_tab you will see the error you're seeing.


Should/Does the code do anything with sheets other than the two that you specify? If the code looked for "Customer Summary" and "Deliverables" only rather that looping through all of them this could make the function work as desired. If the either one of the two specified sheets do not exist - exit the function. But without the loop. Should the function ever sum more than the two sheets specified as arguments?

It appears the function primarily sums value in the ColumnToReturn arg, when the keyword is found. I think the function could be cleaned up.

From your example the summed value should come from the two sheets named "TK Opprotunity" and "Machine 1" if the keyword "TOTAL MACHINERY" is found.
The code does not do anyhting except identify which sheets need to be added together (all those between Customer Summary and Deliverables), then looks for the heading for the subotal ("TOTAL MACHINERY:", and returns the amount so that it can be added to the amounts from other sheets. There will always be a Customer Summary sheet and always a Deliverables sheet, however, the number of sheets between them can be from 1to unlimited. I don't really see any need for it to look at all the sheets. I can certainly clean that up once I figure out how to make the function work again in a non-macro enabled workbook. I truly like your idea of the add-in if I can get the last little piece to work.
 
Upvote 0
The code does not do anyhting except identify which sheets need to be added together (all those between Customer Summary and Deliverables), then looks for the heading for the subotal ("TOTAL MACHINERY:", and returns the amount so that it can be added to the amounts from other sheets. There will always be a Customer Summary sheet and always a Deliverables sheet, however, the number of sheets between them can be from 1to unlimited. I don't really see any need for it to look at all the sheets. I can certainly clean that up once I figure out how to make the function work again in a non-macro enabled workbook. I truly like your idea of the add-in if I can get the last little piece to work.
Have you ever tried using the debug capability of VBA?
You could set a breakpoint in the loop or add a message box to watch the value of variables to try to get a handle on where and why it is not working.
 
Upvote 0
The code does not do anyhting except identify which sheets need to be added together (all those between Customer Summary and Deliverables), then looks for the heading for the subotal ("TOTAL MACHINERY:", and returns the amount so that it can be added to the amounts from other sheets. There will always be a Customer Summary sheet and always a Deliverables sheet, however, the number of sheets between them can be from 1to unlimited. I don't really see any need for it to look at all the sheets. I can certainly clean that up once I figure out how to make the function work again in a non-macro enabled workbook. I truly like your idea of the add-in if I can get the last little piece to work.
You might add this function to your Add-In functions
the check the indexes for the sheets for Customer Summary, Deliverables, and the two sheets in between
in a cell enter the formula =WorksheetIndex("Deliverables") for example. This might help you figure out why you're getting the error in your function.
the function returns a 0 (zero) if the sheet name is not found.

VBA Code:
Public Function WorksheetIndex(sheetname As String) As Integer
  Dim wks As Worksheet
  WorksheetIndex = 0 'not found
  For Each wks In Worksheets()
    If UCase(wks.Name) = UCase(sheetname) Then
      WorksheetIndex = wks.Index
      Exit For
    End If
  Next wks
End Function
 
Upvote 0
You might add this function to your Add-In functions
the check the indexes for the sheets for Customer Summary, Deliverables, and the two sheets in between
in a cell enter the formula =WorksheetIndex("Deliverables") for example. This might help you figure out why you're getting the error in your function.
the function returns a 0 (zero) if the sheet name is not found.

VBA Code:
Public Function WorksheetIndex(sheetname As String) As Integer
  Dim wks As Worksheet
  WorksheetIndex = 0 'not found
  For Each wks In Worksheets()
    If UCase(wks.Name) = UCase(sheetname) Then
      WorksheetIndex = wks.Index
      Exit For
    End If
  Next wks
End Function
Thanks. I added this to the addin and it gives back the correct count when I put in "Deliverables". No problem there. The only way I can make it work is to copy/drag the module fromthe addin project to the current worksheet project thenit works. But as soon as I save it, it gives me the warning that if I save it as a XLSX it can't save VB Project. Then when I proceed and reopen it no longer works becasue it stripped it out of the current document. It is still there in the add-in and I can use it, but it is returning the same error. I am obviously missing something in my add-in that is in the orignal macro-enabled worksheet but I cant find anything.
 
Upvote 0
The code does not do anyhting except identify which sheets need to be added together (all those between Customer Summary and Deliverables), then looks for the heading for the subotal ("TOTAL MACHINERY:", and returns the amount so that it can be added to the amounts from other sheets. There will always be a Customer Summary sheet and always a Deliverables sheet, however, the number of sheets between them can be from 1to unlimited. I don't really see any need for it to look at all the sheets. I can certainly clean that up once I figure out how to make the function work again in a non-macro enabled workbook. I truly like your idea of the add-in if I can get the last little piece to work.

Thanks. I added this to the addin and it gives back the correct count when I put in "Deliverables". No problem there. The only way I can make it work is to copy/drag the module fromthe addin project to the current worksheet project thenit works. But as soon as I save it, it gives me the warning that if I save it as a XLSX it can't save VB Project. Then when I proceed and reopen it no longer works becasue it stripped it out of the current document. It is still there in the add-in and I can use it, but it is returning the same error. I am obviously missing something in my add-in that is in the orignal macro-enabled worksheet but I cant find anything.
What were the index values for the 4 sheets? "Customer Summary", "TK Opprotunity" , "Machine 1", and "Deliverables"?
 
Upvote 0
Solution
ThisWorkbook refers to the workbook the code resides in (i.e. the Addin) and not the Active workbook.
Rich (BB code):
For Each ws In ThisWorkbook.Worksheets
Try replacing it with ActiveWorkbook
 
Upvote 0
ThisWorkbook refers to the workbook the code resides in (i.e. the Addin) and not the Active workbook.
Rich (BB code):
For Each ws In ThisWorkbook.Worksheets
Try replacing it with ActiveWorkbook
That did it! I used the Add-In per bosquedeguate and your correction and I am GOLDEN! A million Thanks to you both.
 
Upvote 0
1,2,3,4 Respectively
Try this version of the function in your add-in (keep your original code for now).
CustomSummary2

It works based on Sheet index numbers

VBA Code:
Function CustomSummary2(init_tab As String, end_tab As String, keyword As String, columnToSearch As String, columnToReturn As String) As Variant

  Dim ws As Worksheet
  Dim startFound As Boolean
  Dim endFound As Boolean
  Dim sumResult As Double
  Dim idxStart As Integer
  Dim idxEnd As Integer
  Dim w As Integer
  
  sumResult = 0
  startFound = False
  endFound = False
  
  Dim initTabExists As Boolean
  Dim endTabExists As Boolean
  initTabExists = False
  endTabExists = False
  
  idxStart = Worksheets(init_tab).Index
  If idxStart = 0 Then
    MsgBox "Start tab " & init_tab & " not found."
    Exit Function
  End If
  idxStart = idxStart + 1
  initTabExists = True
  startFound = True
  idxEnd = Worksheets(end_tab).Index
  If idxEnd = 0 Then
    MsgBox "End tab " & end_tab & " not found."
    Exit Function
  End If
  idxEnd = idxEnd - 1
  endTabExists = True
  endFound = True
  
  For w = idxStart To idxEnd
    Set ws = Worksheets(w)
      
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, columnToSearch).End(xlUp).Row
    
    Dim rng As Range
    Set rng = ws.Range(columnToSearch & "1:" & columnToSearch & lastRow)
    
    Dim cell As Range
    Dim buffer_val As Variant
    
    For Each cell In rng
    
      If cell.Value = keyword Then
      
        Set buffer_val = ws.Range(columnToReturn & cell.Row)
      
        If IsNumeric(buffer_val) Then
      
          sumResult = sumResult + buffer_val.Value
      
        End If
      
      End If
      
    Next cell
      
  Next w

  CustomSummary2 = sumResult


End Function
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,182
Members
453,021
Latest member
Mohamed Magdi Tawfiq Emam

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