Extending a configuration to multiple rows

[MrDJShanahan]

Hi. I'm a bit of a novice when it comes to VBA. I'm trying to extend the following set of commands down from row 2 to row 200. I know that I need to use an Integer, but I cant work it out


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J12")) Is Nothing Then
Range("K12, S12").ClearContents
End If
If Not Intersect(Target, Range("T12")) Is Nothing Then
Range("V12, Y12").ClearContents
End If
If Not Intersect(Target, Range("W12")) Is Nothing Then
Range("Y12, AB12").ClearContents
End If
If Not Intersect(Target, Range("AA12")) Is Nothing Then
Range("AB12:AD12").ClearContents
End If
If Not Intersect(Target, Range("AJ12")) Is Nothing Then
Range("AL12, AO12").ClearContents
End If
If Not Intersect(Target, Range("AN12")) Is Nothing Then
Range("AO12:AQ12").ClearContents
End If
If Not Intersect(Target, Range("AW12")) Is Nothing Then
Range("AY12, BB12").ClearContents
End If
If Not Intersect(Target, Range("AN12")) Is Nothing Then
Range("BB12:BD12").ClearContents
End If
If Not Intersect(Target, Range("BJ12")) Is Nothing Then
Range("BL12, BO12").ClearContents
End If
If Not Intersect(Target, Range("BN12")) Is Nothing Then
Range("BO12:BQ12").ClearContents
End If
If Not Intersect(Target, Range("BW12")) Is Nothing Then
Range("BY12, CB12").ClearContents
End If
If Not Intersect(Target, Range("CA12")) Is Nothing Then
Range("CB12:CD12").ClearContents
End If
End Sub


Any hints or suggestions?

Thanks

D

 

[Kamolga]

I would make one big range from line 2 to to 200 then 'case select' leaving the 'case else' empty

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("J2:CA200")) Is Nothing Then
        Select Case Target.Column
            Case Range("J:J").Column
             Range("K" & Target.Row, "S" & Target.Row).ClearContents
            Case Range("T:T").Column
             Range("V" & Target.Row, "Y" & Target.Row).ClearContents
            Case Range("W:W").Column
             Range("Y" & Target.Row, "AB" & Target.Row).ClearContents
            Case Range("AA:AA").Column
             Range("AB" & Target.Row, "AD" & Target.Row).ClearContents
            Case Range("AJ:AJ").Column
             Range("AL" & Target.Row, "AO" & Target.Row).ClearContents
            Case Range("AN:AN").Column
             Range("AO" & Target.Row, "AQ" & Target.Row).ClearContents
            
           [COLOR=#ff0000] .
            .
            .
            .[/COLOR]
            
            
            
            Case Else
        End Select
    End If
End Sub

 

[MrDJShanahan]

Hi,
Thanks for sharing this. I have entered the formula, but its deleting more than I think its supposed to.


So if I change what is in J12, it then clears K to S instead of clearing K and S


If I understand the code correctly "Range("K" & Target.Row, "S" & Target.Row).ClearContents" should just clear K and S so not sure why its clearing the other cells between K and S


Same happens if I change T12. It clears All cells from V to Y instead of just V and Y.


Is there something in the code that's causing this or is there a setting somewhere?

 

[Fluff]

Try it like

Intersect(Target.EntireRow, Range("K:K,S:S")).ClearContents

 

[MrDJShanahan]

Perfect - works like a charm

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J2:CA200")) Is Nothing Then
Select Case Target.Column
Case Range("J:J").Column
Intersect(Target.EntireRow, Range("K:K,S:S")).ClearContents
Case Range("T:T").Column
Intersect(Target.EntireRow, Range("V:V,Y:Y")).ClearContents
Case Range("W:W").Column
Intersect(Target.EntireRow, Range("Y:Y,AB:AB")).ClearContents
Case Range("AA:AA").Column
Intersect(Target.EntireRow, Range("AB:AD")).ClearContents
Case Range("AJ:AJ").Column
Intersect(Target.EntireRow, Range("AL:AL,AO:AO")).ClearContents
Case Range("AN:AN").Column
Intersect(Target.EntireRow, Range("AO:AQ")).ClearContents
Case Range("AW:AW").Column
Intersect(Target.EntireRow, Range("AY:AY,BB:BB")).ClearContents
Case Range("BA:BA").Column
Intersect(Target.EntireRow, Range("BB:BE")).ClearContents
Case Range("BJ:BJ").Column
Intersect(Target.EntireRow, Range("BL:BL,BO:BO")).ClearContents
Case Range("BN:BN").Column
Intersect(Target.EntireRow, Range("BO:BQ")).ClearContents
Case Range("BW:BW").Column
Intersect(Target.EntireRow, Range("BY:BY,CB:CB")).ClearContents
Case Range("BA:BA").Column
Intersect(Target.EntireRow, Range("CB:CE")).ClearContents
Case Else
End Select
End If
End Sub

 

[Fluff]

Glad we could help & thanks for the feedback