CODEWITHSUNDEEP
excelvba
Ashraf Fouad
Ashraf Fouad

Reputation: 133

How to get the cell address if I used a VBA function on such cell?

I want to use a VBA function ScopeSum() in an Excel table, such function is checking the "1" values on the same row & then sum relevant header's values.
"SopeH" is named header range.
I've to use this function on the same column (column "P" for the below example) for 100's of rows.
If I copy the function cell & fill all rows the result is as the first cell, but if I edit it, it works fine.

Function ScopeSum() As String
Dim i As Integer
Dim j As Long
Dim rng As Range
Dim cur_rng As Range
Dim ScopeText As String
Dim cell As Variant
Set rng = Range("ScopeH")
j = Range(ActiveCell.Address).Row

Set cur_rng = Range("ScopeH").Offset(j - 2, 0)
i = 0
ScopeText = ""
For Each cell In cur_rng.Cells
    i = i + 1
    If UCase(cell.Value) = 1 Then ScopeText = ScopeText & ", " & Application.WorksheetFunction.Index(rng, 1, i)
Next
ScopeSum = ScopeText
End Function

Excel Table
Excel Table

After refreshing the page
After refreshing the page

Upvotes: 0

Views: 696

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

Make sure you submit the data and header ranges as parameters, so the UDF (user defined function) works for any data range and depends on the data range. Otherwise your formula would not update automatically if the data changes.

Option Explicit

Public Function ScopeSum(ByVal DataRange As Range, ByVal HeaderRange As Range) As String
    Dim Data() As Variant       ' read data into array
    Data = DataRange.Value
    
    Dim Header() As Variant     ' read header into array
    Header = HeaderRange.Value
    
    Dim Result As String        ' collect results for output here
    
    Dim iCol As Long
    For iCol = 1 To UBound(Data, 2)  ' loop through data and concatenate headers
        If Data(1, iCol) = 1 Then
            Result = Result & IIf(Result <> vbNullString, ", ", vbNullString) & Header(1, iCol)
        End If
    Next iCol
    
    ScopeSum = Result  ' output results
End Function

Then use the following formula in cell P3:

=ScopeSum(Q3:Z3,$Q$2:$Z$2)

Make sure the header is fixed with the $ signs in the formula. And copy it down:

enter image description here

This has the advantage that you never need to change the code, even if the ranges change. Also you could easily add an Item 11 without changing the code by just adjusting the ranges in the formula.

Upvotes: 2

Related Questions