Opgelost Bereik van een VBA code

[jjmermen]

In deze VBA code wil ik graag wil dat de code alleen in een bepaald bereik werkt. Bijvoorbeeld in het bereik B7:AV500. Is dat mogelijk?
In de rijen 1 t/m 5 heb ik namelijk opmaak zitten die ik niet kwijt wil. De VBA code die ik nu heb maakt alle bestaande opmaak leeg.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
' Clear the color of all the cells
Cells.Interior.ColorIndex = 0
With Target
' Highlight the entire row that contain the active cell
.EntireRow.Interior.ColorIndex = 19
' Highlight the active cell
Target.Interior.ColorIndex = 6
End With
Application.ScreenUpdating = True
End Sub

 

[emields]

code tussen codetags en een voorbeeldbestandje.

 

[edmoor]

Daar is Application.Intersect voor:

Application.Intersect method (Excel)

Office VBA reference topic

learn.microsoft.com

Verder:
Zie #2.

 

[jjmermen]

@emields : Slordig van me. In de bijlage ook een voorbeeld bestandje, waarbij ik graag wil dat VBA het alleen in het bereik van B716 werkt.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
' Clear the color of all the cells
Cells.Interior.ColorIndex = 0
With Target
' Highlight the entire row that contain the active cell
.EntireRow.Interior.ColorIndex = 19
' Highlight the active cell
Target.Interior.ColorIndex = 6
End With
Application.ScreenUpdating = True
End Sub

 

[edmoor]

Dus je hebt Application.Intersect al bekeken?

 

[jjmermen]

Klopt, ik heb Application.Intersect al bekeken. Mijn ervaring is niet zo dat ik zelf een VBA kan aanpassen.
De VBA die ik meegestuurd heb, heb ik van het internet gehaald.
Ik zou er graag wat hulp bij kunnen gebruiken.

 

[edmoor]

Kijk eens naar dit:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Application.Intersect(Range(Target.Address), Range("B7:D16")) Is Nothing Then
        If Target.Cells.Count > 1 Then Exit Sub
        Application.ScreenUpdating = False
        ' Clear the color of all the cells
        Cells.Interior.ColorIndex = 0
        With Target
            ' Highlight the entire row that contain the active cell
            .EntireRow.Interior.ColorIndex = 19
            ' Highlight the active cell
            Target.Interior.ColorIndex = 6
        End With
        Application.ScreenUpdating = True
    End If
End Sub

 

[jjmermen]

Perfect. Dank je wel @edmoor

 

[jjmermen]

Oeps, ik heb te vroeg gejuicht. De opmaak buiten dit bereik wordt nog gewist.
Is dat ook aan te passen?

 

[edmoor]

Dan zo:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Application.Intersect(Range(Target.Address), Range("B7:D16")) Is Nothing Then
        If Target.Cells.Count > 1 Then Exit Sub
        Application.ScreenUpdating = False
        Range("B7:D16").Interior.ColorIndex = 0
        Range("B" & Target.Row).Resize(, 3).Interior.ColorIndex = 19
        Target.Interior.ColorIndex = 6
        Application.ScreenUpdating = True
    End If
End Sub

 

[jjmermen]

Top, Dank je wel.

 

[AHulpje]

Of maak er een tabel van:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Me.ListObjects("Tabel1").DataBodyRange) Is Nothing Then
        Range("Tabel1[[Artikelcode]:[Merk]]").Interior.ColorIndex = 0
        rij = Target.Row - Me.ListObjects("Tabel1").Range.Row
        Range("Tabel1[[Artikelcode]:[Merk]]").Rows(rij).Interior.ColorIndex = 19
        Target.Interior.ColorIndex = 6
    End If
End Sub