VBA code to clear contents of certain ranges below specified header

user_19839983 0
Viewed 51

I'm new to VBA trying to fumble my way through this, any guidance would be most appreciated! I have a worksheet, and I want to Clear the contents of cells 17-37, 45-60, 65-79 ; with the column being determined by the header (in Row 15) being equal to the value in Cell B1 of same worksheet. My sheet has columns C-Z that need to be looked at

I have tried to write a loop, or use other parts of code found online and I am unable to figure out how to add the lookup part so that it will only clear in the column if the value in row 15 of the column match B1.

EDIT: Here is what I had so far, based on comments but it still will not find my value so cindex returns Error 2042 - checked for leading or trailing spaces.

Set ws to FORECAST Dim ws As Worksheet Set ws = ActiveWorkbook.Worksheets("FORECAST") 'Set range to search Dim hrg As Range Set hrg = ws.Range("C15:Z15") 'set range to clear contents Dim crg As Range Set crg = ws.Range("17:37,45:60,65:79")

'Set header value to find Dim Header As Variant Header = ws.Range("B1").Value

'hold column where match is found Dim cIndex As Variant cIndex = Application.Match(Header, hrg, 0)

'validate column index and clear If IsNumeric(cIndex) Then Intersect(hrg.Cells(cIndex).EntireColumn, crg).Clear 'else no match found; no nothing End If

End Sub

vba excel loops
2 Answers

Clear Cells When Matching Header

Sub ClearColumn()
    
    ' Worksheet
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Header Range
    Dim hrg As Range: Set hrg = ws.Range("C15:Z15")
    
    ' Clear-Entire-Rows Range
    Dim crg As Range: Set crg = ws.Range("17:37,45:60,65:79")

    ' Header (Value)
    Dim Header As Variant: Header = ws.Range("B1").Value
    
    ' Column Index (index of the matching cell (column)
    ' of the Header range (if a match))
    Dim cIndex As Variant: cIndex = Application.Match(Header, hrg, 0)
    
    ' Validate the Column index and clear.
    If IsNumeric(cIndex) Then ' match found
        Intersect(hrg.Cells(cIndex).EntireColumn, crg).Clear
    'Else ' no match found; do nothing
    End If
    
End Sub
user_98140690

Solution

Sub ClearByHeaderName()

    Dim criteriaCell    As Range
    Dim headerCells     As Range
    Dim headerCell      As Range
    Dim isColumnCleared As Boolean
    
    Set criteriaCell = Range("B1")
    If criteriaCell.Value = "" Then
        MsgBox "Provide column name in B1!", vbExclamation
        End
    End If
    Set headerCells = Range("C15:Z15")
    
    For Each headerCell In headerCells
        If headerCell.Value = criteriaCell.Value Then
            ClearDataCells headerCell
            isColumnCleared = True
        End If
    Next
    
    If isColumnCleared Then
        MsgBox "Done!", vbInformation
    Else
        MsgBox "Cannot find column '" & criteriaCell.Value & "'!", vbExclamation
    End If

End Sub

Private Sub ClearDataCells(headerCell As Range)

    With headerCell.EntireColumn
        .Rows("17:37").Clear
        .Rows("45:60").Clear
        .Rows("65:79").Clear
    End With

End Sub
user_63595030
Related