I am using the below code to do the following:

if I select any cell of A,D or E on any row (rows) then subsequently select Cells B:G on the same row (rows). it works , But the Problem If I select any whole column of (A,D or E) then excel hangs and not responding.
as always,any help will be appreciated.

Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)

    Const cFirstRow As String = "A3,D3,E3"
    Const sCols As String = "B:G"

    Dim crg As Range
    With Range(cFirstRow)
        Set crg = Intersect(.Areas(1).EntireRow.Resize(Rows.Count - .Row   1), .EntireColumn)
    End With

    Dim irg As Range: Set irg = Intersect(crg, Target)

    If Not irg Is Nothing Then

        Dim srg As Range, arg As Range, rrg As Range
        For Each arg In irg.Areas
            For Each rrg In arg.Rows
                If srg Is Nothing Then
                    Set srg = Columns(sCols).Rows(rrg.Row)
                Else
                    Set srg = Union(srg, Columns(sCols).Rows(rrg.Row))
                End If
            Next rrg
        Next arg

        If Not srg Is Nothing Then
            srg.Select
        End If
      End If
    
  End Sub

CodePudding user response：

Please, try your adapted code in the next way, which does the same, almost instant, but I do not think it is wise to use it...

Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)

    Const cFirstRow As String = "A3,D3,E3"
    Const sCols As String = "B3:G3"

    Dim crg As Range, rngBG As Range
    With Range(cFirstRow)
        Set crg = Intersect(.Areas(1).EntireRow.Resize(rows.Count - .row   1), .EntireColumn)
        Set rngBG = Intersect(Range(sCols).Areas(1).EntireRow.Resize(rows.Count - Range(sCols).row   1), Range(sCols).EntireColumn)
    End With

    Dim irg As Range: Set irg = Intersect(crg, Target)
    
    If Not irg Is Nothing Then
        Dim srg As Range
        Set srg = Intersect(rngBG, irg.EntireRow)

        If Not srg Is Nothing Then
            Application.EnableEvents = False 'without this part, the event will run twice
             srg.Select
             Application.EnableEvents = True
        End If
      End If
    
  End Sub

CodePudding user response：

If all you need is to also select "B:G" in the same row whenever the user selects something in "A, D or E" then there's no need for so many lines of code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim TrimmedRange As Range
    Set TrimmedRange = Intersect(Target, Me.Range("A:A,D:D,E:E"))
    If TrimmedRange Is Nothing Then Exit Sub
    Union(Target, Intersect(TrimmedRange.EntireRow, Me.Range("B:G"))).Select
End Sub

If you want to exclude Rows 1 & 2 from this interaction, you can add a few lines:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim TrimmedRange As Range
    Set TrimmedRange = Intersect(Target, Me.Range("3:" & Me.Rows.Count))
    If TrimmedRange Is Nothing Then Exit Sub
    Set TrimmedRange = Intersect(TrimmedRange, Me.Range("A:A,D:D,E:E"))
    If TrimmedRange Is Nothing Then Exit Sub
    Union(Target, Intersect(TrimmedRange.EntireRow, Me.Range("B:G"))).Select
End Sub

An Explanation of the above code:

• Me.Range("3:" & Me.Rows.Count) : Create a range of everything from row 3 to the end of the sheet.
• Intersect(Target, ... : Compare Target to the range, return all cells that are in both ranges. This is effectively trimming the user's selected range by removing anything in the excluded row 1 or 2.
• Set TrimmedRange = ... : Save that trimmed range to a variable.
• Intersect(TrimmedRange, Me.Range("A:A,D:D,E:E")) : Remove every cell that isnt in columns A,D,E
• Set TrimmedRange = ... : Save that double-trimmed range to the variable
• TrimmedRange.EntireRow : Extend the remaining cells into full rows.
• Intersect(TrimmedRange.EntireRow, Me.Range("B:G")) : Compare those rows to the columns "B:G" and find any overlapping cells. Esentially extends the A,D,E cells into full rows and then takes the "B:G" portion of it.
• Union(Target, ... : Re-Add the original user-selected range back into this whole thing
• Select : Select the finished range.

CodePudding user response：

Select Row Ranges of a Selection

• This is in the spirit of the posted code. The result is probably the same as in FaneDuru's solution who tackled it a bit differently.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

    Const cFirstRow As String = "A3,D3,E3"
    Const sCols As String = "B:G"

    Dim crg As Range
    With Range(cFirstRow)
        Set crg = Intersect(.Areas(1).EntireRow _
            .Resize(Rows.Count - .Row   1), .EntireColumn)
    End With

    Dim irg As Range: Set irg = Intersect(crg, Target)

    If Not irg Is Nothing Then
        Dim srg As Range: Set srg = Intersect(irg.EntireRow, Columns(sCols))
        Application.EnableEvents = False
        srg.Select
        Application.EnableEvents = True
    End If
    
End Sub