VBA function not working.

Question

Hey! i need you people help in a function i built.

the function suppose to run on a table that is given, the each column could be string or numeric. for each numeric column, it creates a "mini summary" that basically do some calculation based on the unique values on all the corresponding string columns data.

so for example if i have a table with 3 string columns and 2 numeric, it will create for each of the two numeric columns 3 "mini summaries" tables -> one for each string based column.

the code is kinda working but i have a problem with the uniqueValues variable and specificly in this row:

• For Each cell In uniqueValues
• the error that im getting is "424 runtime error-object requried"

Function GenerateStringColumnSummary(ByVal percentage As Double) As Worksheet

Dim ws As Worksheet 

Dim originalData As Range 

Dim summaryWs As Worksheet 

Dim dataTypes As Variant 

Dim lastCol As Long, lastRow As Long 

Dim col As Long, row As Long 

Dim uniqueValues As Collection 

Dim cell As Range 

Dim headerName As String 

Dim numericCol As Long 

Dim lowerBound As Double, upperBound As Double 

Dim belowCount As Long, rangeCount As Long, aboveCount As Long 

' Store reference to the original active sheet 

Set ws = ThisWorkbook.ActiveSheet 

' Set the summary worksheet 

On Error Resume Next 

Set summaryWs = ThisWorkbook.Sheets("String Column Summary") 

On Error GoTo 0 

If summaryWs Is Nothing Then 

    Set summaryWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)) 

    summaryWs.Name = "String Column Summary" 

Else 

    summaryWs.Cells.Clear 

End If 

ws.Activate 

' Get data types of each column 

dataTypes = GetColumnDataTypes() 

lastCol = UBound(dataTypes) 

' Get the last row and last column of the data 

lastRow = GetTableSize()(0) 

' Loop through each string column 

For col = 1 To lastCol 

    If dataTypes(col) = "String" Then 

        ' Write header name to summary sheet 

        headerName = ws.Cells(1, col).Value 

        summaryWs.Cells(1, 1).Value = "Summary for String Columns" 

        summaryWs.Cells(2, 1).Value = "String Column Name" 

        summaryWs.Cells(2, 2).Value = "Unique Value" 

        summaryWs.Cells(2, 3).Value = "Lower Bound" 

        summaryWs.Cells(2, 4).Value = "Average" 

        summaryWs.Cells(2, 5).Value = "Upper Bound" 

        summaryWs.Cells(2, 6).Value = "Below Count" 

        summaryWs.Cells(2, 7).Value = "Range Count" 

        summaryWs.Cells(2, 8).Value = "Above Count" 

        ' Get unique values and counts 

        Set uniqueValues = New Collection 

For Each cell In ws.Range(ws.Cells(2, col), ws.Cells(ws.Rows.count, col).End(xlUp))

If Not IsError(cell.Value) Then 

    On Error Resume Next 

    uniqueValues.Add cell.Value, CStr(cell.Value) 

    Debug.Print cell.Value 

    On Error GoTo 0 

End If 

Next cell

        ' Loop through unique values 

        For Each cell In uniqueValues 

            ' Get average for the corresponding numeric column 

            For numericCol = 1 To lastCol 

                If dataTypes(numericCol) Like "Double\*" Or dataTypes(numericCol) Like "Integer\*" Or dataTypes(numericCol) Like "Long\*" Then 

                    lowerBound = Application.WorksheetFunction.AverageIf(ws.Columns(numericCol), ws.Cells(ws.Rows.count, col), ws.Columns(numericCol)) \* (1 - percentage) 

                    upperBound = Application.WorksheetFunction.AverageIf(ws.Columns(numericCol), ws.Cells(ws.Rows.count, col), ws.Columns(numericCol)) \* (1 + percentage) 

                    summaryWs.Cells(summaryWs.Cells(summaryWs.Rows.count, 1).End(xlUp).row + 1, 1).Value = headerName 

                    summaryWs.Cells(summaryWs.Cells(summaryWs.Rows.count, 2).End(xlUp).row + 1, 2).Value = cell 

                    summaryWs.Cells(summaryWs.Cells(summaryWs.Rows.count, 1).End(xlUp).row, 3).Value = lowerBound 

                    summaryWs.Cells(summaryWs.Cells(summaryWs.Rows.count, 1).End(xlUp).row, 4).Value = Application.WorksheetFunction.AverageIf(ws.Columns(numericCol), ws.Cells(ws.Rows.count, col), ws.Columns(numericCol)) 

                    summaryWs.Cells(summaryWs.Cells(summaryWs.Rows.count, 1).End(xlUp).row, 5).Value = upperBound 

                    belowCount = Application.WorksheetFunction.CountIfs(ws.Columns(numericCol), "<" & lowerBound, ws.Columns(col), cell) 

                    summaryWs.Cells(summaryWs.Cells(summaryWs.Rows.count, 1).End(xlUp).row, 6).Value = belowCount 

                    rangeCount = Application.WorksheetFunction.CountIfs(ws.Columns(numericCol), ">" & lowerBound, ws.Columns(numericCol), "<" & upperBound, ws.Columns(col), cell) 

                    summaryWs.Cells(summaryWs.Cells(summaryWs.Rows.count, 1).End(xlUp).row, 7).Value = rangeCount 

                    aboveCount = Application.WorksheetFunction.CountIfs(ws.Columns(numericCol), ">" & upperBound, ws.Columns(col), cell) 

                    summaryWs.Cells(summaryWs.Cells(summaryWs.Rows.count, 1).End(xlUp).row, 8).Value = aboveCount 

                End If 

            Next numericCol 

        Next cell 

    End If 

Next col 

Set GenerateStringColumnSummary = summaryWs 

End Function

Answer 1

You add the value to the collection:

      uniqueValues.Add cell.Value, CStr(cell.Value)

But "cell" is used and declared as Range!

  ' Loop through unique values  
  For Each cell In uniqueValues  

Andreas.