How can I run a vba I wrote against all of the rows of my excel sheet?

Question

I have following script. I need to run it against 27,000 rows in excel.

The output should be dropped into column DG at the end of every row. It should be crunching the values in the cells between columns C and DF (108 cells).

Function binning()
Dim rng As Range
Dim str, binStat, temp As String
Dim passes As Integer

Set passes = 0
Set rng = Application.Selection
Set binStat = "High"

For Each cell In rng
    temp = cell.Value

    Select Case temp

    Case "Passed"
        passes = passes + 1
        If passes = 2 Then
            If binStat = "High" Then
                binStat = "Medium"
                passes = 0
            ElseIf binStat = "Medium" Then
                binStat = "Low"
                passes = 0
            ElseIf binStat = "Low" Then
                passes = 0
            End If
        End IF  
    Case "Failed"
        passes = 0
        If binStat = "High" Then
            binStat = "High"
        ElseIf binStat = "Medium" Then
            binStat = "High"
        ElseIf binStat = "Low"  Then
            binStat = "Medium"
        End If  
    End Select
Next cell

binning = binStat
End Function    

So basically it should be running across each row between C and DF and in DG setting the value as High, Medium, or Low based on the script. Starts on row 2 of the sheet.

Trouble is - I am have no idea how to make that happen in excel 2007.

Answer 1

Maybe something like this (uses sub rather than function):

Option Explicit

Sub AssignRowValuesToBins()

    ' Change to whatever your sheet is called. I assume Sheet1.
    With ThisWorkbook.Worksheets("Sheet1")

        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row

        Dim arrayOfValues() As Variant
        arrayOfValues = .Range("C2:DG" & lastRow).Value2

        Dim rowIndex As Long
        Dim columnIndex As Long

        Dim binStat As String
        Dim passCount As Long

        Dim writeColumnIndex As Long
        writeColumnIndex = UBound(arrayOfValues, 2)

        For rowIndex = LBound(arrayOfValues, 1) To UBound(arrayOfValues, 1)
            binStat = "High"
            passCount = 0
            For columnIndex = LBound(arrayOfValues, 2) To (writeColumnIndex - 1)
                If AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Passed") Then
                    passCount = passCount + 1
                    If passCount = 2 Then
                        If AreStringsIdentical(binStat, "High") Then
                            binStat = "Medium"
                            passCount = 0
                        ElseIf AreStringsIdentical(binStat, "Medium") Then
                            binStat = "Low"
                            passCount = 0
                        ElseIf AreStringsIdentical(binStat, "Low") Then
                            passCount = 0
                        End If
                    End If
                ElseIf AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Failed") Then
                    passCount = 0
                    If AreStringsIdentical(binStat, "High") Then
                        binStat = "High"
                    ElseIf AreStringsIdentical(binStat, "Medium") Then
                        binStat = "High"
                    ElseIf AreStringsIdentical(binStat, "Low") Then
                        binStat = "Medium"
                    End If
                Else
                    arrayOfValues(rowIndex, writeColumnIndex) = "Unexpected value '" & arrayOfValues(rowIndex, columnIndex) & "'"
                End If
            Next columnIndex
            arrayOfValues(rowIndex, writeColumnIndex) = binStat
        Next rowIndex

        .Range("C2").Resize(UBound(arrayOfValues, 1), UBound(arrayOfValues, 2)).Value2 = arrayOfValues
    End With
End Sub

Private Function AreStringsIdentical(ByVal firstString As String, ByVal secondString As String) As Boolean
    ' Performs case-sensitive comparison.
    AreStringsIdentical = (VBA.Strings.StrComp(firstString, secondString, vbBinaryCompare) = 0)
End Function