Hello Everyone I was working on trying to write a routine that would redact sensitive information in reports that that would have varying degrees of rows and columns. It uses a collection as a master list of qualifiable columns to redact and searches for them in the report. If a match is found it then finds the column and address. Creates a string range address for that column which is used in the line


For Each Cell In Worksheets("Sheet1").Range(sTempRange)
     Cell.Value = sRedact
Next Cell
However, I get a Subscript out of range runtime error for the For Each line above. I was wondering what is causing this when I have thousands of rows to redact butit will work when there are only a few rows to redact.


Option Explicit

Public Sub DeIdentify()
    Call SearchColumnNames(CreateCollection)

End Sub


Private Function CreateCollection() As collection

    Dim collHideColumn As New collection

    collHideColumn.Add "Sensitive Field1"
    collHideColumn.Add "Sensitive Field2"
    collHideColumn.Add "Sensitive Field3"
    collHideColumn.Add "Sensitive Field4"
    collHideColumn.Add "Sensitive Field5"
    collHideColumn.Add "Sensitive Field6"
    collHideColumn.Add "Sensitive Field7"

    Set CreateCollection = collHideColumn
End Function

Public Sub SearchColumnNames(ByRef aCollection As collection)
    Dim columnName As Variant
    Dim HeaderName As String
    Dim Address As String
    Dim newAddress As String
    Dim tempColumnValue As String
    Dim ColumnValue As String
    Dim LastRow As Long
    Dim ws As Worksheet
    Dim WorksheetName As String
    WorksheetName = ActiveSheet.Name
    Set ws = Sheets(WorksheetName)


    For Each columnName In aCollection
          Address = ""
          newAddress = ""
          HeaderName = columnName
          Address = GetColAddressByHeaderName1(columnName)
         'MsgBox "The Address of " & HeaderName & " is: " & Address, vbOKOnly
       ColumnValue = Range(Address).column
      ' MsgBox "The ColumnValue of " & HeaderName & " is: " & ColumnValue, vbOKOnly
       'MsgBox "The  value in Range" & nCol & row & "is" & "" & Range(nCol & row).text, vbOKOnly, "Debug"
       LastRow = ws.Range("A1").CurrentRegion.Rows.Count
       Call RedactCellValueByColumnV1(ColumnValue, LastRow)



    Next
End Sub

Public Function GetColAddressByHeaderName1(ByVal HeaderName As String) As String
Dim iRow As Integer
Dim iCol As Integer
Dim J As Integer
Dim WorksheetName As String
Dim DataRange As Range
iCol = 1
iRow = 1
WorksheetName = ActiveSheet.Name
With Worksheets(WorksheetName)
    Do Until Cells(iRow, iCol).Value = ""
        Do Until Cells(iRow, iCol).Value = ""
            If Cells(iRow, iCol).Value = HeaderName Then
                GetColAddressByHeaderName1 = ActiveSheet.Cells(iRow, iCol).Address
                Exit Function
            Else
                iCol = iCol + 1
            End If
        Loop
        iCol = 1
        iRow = iRow + 1
    Loop
End With
End Function

Public Sub RedactCellValueByColumnV1(ByVal ColumnLocation As String, ByVal    LastRow As String)

   Dim ws As Worksheet
   Dim WorksheetName As String
   Dim iRow As Long
   Dim iCol As String
   Dim rng1 As Range
   Dim Cell As Range
   Dim lastPopRow As String
   'Dim iColumnLetter As String
   Dim sStartCell As String
   Dim sEndCell As String
   Dim sTempRange As String
   Dim sRedact As String

   WorksheetName = ActiveSheet.Name
   Set ws = Sheets(WorksheetName)
   lastPopRow = ""
   lastPopRow = LastRow
   iRow = 2
   iCol = ""
   iCol = ColumnLocation
   'iColumnLetter = ""
   'iColumnLetter = GetCol_Letter(CLng(ColumnLocation))
   'sStartCell = "$" & GetCol_Letter(CLng(ColumnLocation)) & "$" & CStr(iRow)
    'sEndCell = "$" & GetCol_Letter(CLng(ColumnLocation)) & "$" & lastPopRow
    sStartCell = GetCol_Letter(CLng(ColumnLocation)) & CStr(iRow)
    sEndCell = GetCol_Letter(CLng(ColumnLocation)) & lastPopRow
    sTempRange = sStartCell & ":" & sEndCell
    sRedact = "DE-IDENTIFY"

    For Each Cell In Worksheets("Sheet1").Range(sTempRange)
         Cell.Value = sRedact
    Next Cell


End Sub

Function GetCol_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    GetCol_Letter = vArr(0)
End Function