VBA code to see if an entire row has been selected.

[dpaton05]

I need some code to see if an entire row has been selected within a range and also I need code to see if an entire row has been selected within a table, tblCosting.

Thanks,
Dave

 

[dpaton05]

igold's code doesn't comprehend the possibility that multiple, perhaps non-contiguous, table rows are selected - perhaps that's the source of your unexpected results.
This code will catch multiple row selections within the table including non-contiguous:

Sub test()
    Dim tbl As Object, Ar As Range
    Dim i As Long, j As Long, k As Long
    Set tbl = ActiveSheet.ListObjects("tblCosting")
    If TypeName(Selection) = "Range" Then
        If Not Intersect(Selection, tbl.Range) Is Nothing Then
            For i = 1 To Selection.Areas.Count
                For j = 1 To Selection.Areas(i).Rows.Count
                    For k = 1 To tbl.ListRows.Count
                        If Selection.Areas(i).Rows(j).Address = tbl.ListRows(k).Range.Address Then
                            MsgBox "Row: " & k & " of the table is selected."
                        End If
                    Next k
                Next j
            Next i
        Else
            MsgBox "No table rows selected"
        End If
    Else
        MsgBox "Current selection is not a range object"
    End If
End Sub

It displays the message of No table rows selected but if you have nothing selected but with a row selected, pressing the button will not display the other message box.

 

[dpaton05]

I am creating a spreadsheet for work and I want to add in a check for when quotes don't get accepted and need to be transferred to a different section of the another workbook as a reminder to the user to select the row first.

 

[dpaton05]

Maybe this....but my question remains.....WHY ???

Sub MM1()
ActiveCell.EntireRow.Select
If Intersect(ActiveCell.EntireRow, ActiveSheet.ListObjects("tblCosting").DataBodyRange) Is Nothing Then
      MsgBox "active row is NOT within the table"
   Else
      MsgBox "active row is within the table"
End If
End Sub

That is perfect thanks Michael

 

[dpaton05]

I took that code and tried to add a procedure into the else part, if the row is selected but it won't work. The procedure is otherwise working. Could you have a look at my code please to see what I have left out.

Sub cmdNot_Accept_Click()
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim tblrow As ListRow
Dim Combo As String
Dim sht As Worksheet
Dim tbl As ListObject
Dim LastRow As Long
Dim DocYearName As String
        
ActiveCell.EntireRow.Select
With Selection
    If Intersect(ActiveCell.EntireRow, ActiveSheet.ListObjects("tblCosting").DataBodyRange) Is Nothing Then
          MsgBox "active row is NOT within the table"
       Else
          
          
           Combo = "Not accepted quotes"
                'lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
                    
                If tblrow.Range.Cells(1, 6).Value = "Ang Wes" Then
                    DocYearName = tblrow.Range.Cells(1, 37).Value
                Else
                    DocYearName = tblrow.Range.Cells(1, 36).Value
                End If
                Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
                    With wsDst
                        'This copies the first 10 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                        tblrow.Range.Resize(, 8).Copy
                        .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
    
                            Rows("3:1000").Select
                            Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Clear
                            Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Add Key:=Range("A4:A1000"), _
                                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                                    With Workbooks(DocYearName).Worksheets(Combo).Sort
                                        .SetRange Range("A3:AJ1000")
                                        .header = xlYes
                                        .MatchCase = False
                                        .Orientation = xlTopToBottom
                                        .SortMethod = xlPinYin
                                        .Apply
                                    End With
                    End With
          
          
          
    End If
End With
End Sub

Thanks Michael,
Dave

 

[dpaton05]

Actually this is the entire code that relates to every row. What do I change to make it apply to only the selected row?

        For Each tblrow In tbl.ListRows
            Combo = tblrow.Range.Cells(1, 26).Value
            'lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
                
            If tblrow.Range.Cells(1, 6).Value = "Ang Wes" Then
                DocYearName = tblrow.Range.Cells(1, 37).Value
            Else
                DocYearName = tblrow.Range.Cells(1, 36).Value
            End If
            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
                With wsDst
                    'This copies the first 10 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 8).Copy
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
                    '.Cells.Range(1, 9).PasteSpecial xlPasteFormulas

'.Range("A" & Rows.Count).End(xlUp).Offset(8).PasteSpecial xlPasteFormulas
                    
                    'This should go to the 15th column in the current row, i.e. column O, and copy that column and the next 2 columns, i.e. O:Q, to column K on the destination sheet.
                        'tblrow.Range.Offset(, 14).Resize(, 3).copy
                        '.Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'Similarly this should copy columns AD:AF from the table to column N on the destination sheet.
                        'tblrow.Range.Offset(, 29).Resize(, 3).copy
                        '.Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'Sort rows based on date
                        Rows("3:1000").Select
                        Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Clear
                        Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Add Key:=Range("A4:A1000"), _
                            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                                With Workbooks(DocYearName).Worksheets(Combo).Sort
                                    .SetRange Range("A3:AJ1000")
                                    .header = xlYes
                                    .MatchCase = False
                                    .Orientation = xlTopToBottom
                                    .SortMethod = xlPinYin
                                    .Apply
                                End With
                End With
        Next tblrow

Thanks Michael,
Dave

 

[Michael M]

I don't have Excel at the moment, but i notice you have declared
Dim tblrow As ListRow

But ListRow of what ??

 

[dpaton05]

I just copied the procedure that I know worked, not sure if I actually needed it all or not.

 

[Michael M]

Cant test it but why not

Sub cmdNot_Accept_Click()
Dim wsDst As Worksheet, wsSrc As Worksheet
Dim tblrow As ListRow, Combo As String
Dim sht As Worksheet, tbl As ListObject
Dim LastRow As Long, DocYearName As String
        
[color=red]ActiveCell.EntireRow.Select
With Selection
    If Intersect(ActiveCell.EntireRow, ActiveSheet.ListObjects("tblCosting").DataBodyRange) Is Nothing Then
          MsgBox "active row is NOT within the table"
       Exit Sub
       End If[/color]
          
          
           Combo = "Not accepted quotes"
                'lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
                    
                If tblrow.Range.Cells(1, 6).Value = "Ang Wes" Then
                    DocYearName = tblrow.Range.Cells(1, 37).Value
                Else
                    DocYearName = tblrow.Range.Cells(1, 36).Value
                End If
                Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
                    With wsDst
                        'This copies the first 10 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                        tblrow.Range.Resize(, 8).Copy
                        .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
    
                            Rows("3:1000").Select
                            Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Clear
                            Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Add Key:=Range("A4:A1000"), _
                                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                                    With Workbooks(DocYearName).Worksheets(Combo).Sort
                                        .SetRange Range("A3:AJ1000")
                                        .header = xlYes
                                        .MatchCase = False
                                        .Orientation = xlTopToBottom
                                        .SortMethod = xlPinYin
                                        .Apply
                                    End With
                    End With
          
          
          
End With
End Sub