get position of activecell in a named table-CodePudding

so i have a table named "Table1" in "sheet1" which range is from A2:B4, if i select B3 that would be Sheet("sheet1").range("Table1").cells(2,2) how would you check thru vba that the activecell in table1 is in cells(2,2)

im doing this because i will be copying/reflecting the value to another named table in another sheet to the same cells(2,2) the table has the same no. of rows and columns, it is exactly the same table just located in another sheet and in a different range

CodePudding user response：

You could do it like this:

Sub Tester()
    
    Dim rngT1 As Range, rngT2 As Range, rng As Range, rng2 As Range, addr
    
    Set rngT1 = ActiveSheet.Range("Table1")
    Set rngT2 = ActiveSheet.Range("Table2") 'could be different sheet...

    Set rng = Application.Intersect(Selection, rngT1) 'part of selection within Table1
    
    If Not rng Is Nothing Then   'any selection in table?
        'get the address of the selection *relative* to Table1
        addr = rng.Offset(-rngT1.Row   1, -rngT1.Column   1).Address(False, False)
        Debug.Print addr
        Set rng2 = rngT2.Range(addr) 'same relative range in Table2
        rng2.Select 'for example
    End If
    
End Sub

CodePudding user response：

Reference the Same Cell in Another Same Sized Table

Sub ReferenceSameCell()
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sws As Worksheet: Set sws = wb.Sheets("Sheet1")
    Dim slo As ListObject: Set slo = sws.ListObjects("Table1")
    Dim srg As Range: Set srg = slo.Range
    
    Dim sCell As Range: Set sCell = ActiveCell
    
    If Not sCell.Worksheet Is sws Then
        MsgBox "Select a cell in worksheet '" & sws.Name & "'.", vbExclamation
        Exit Sub
    End If
    
    If Intersect(sCell, srg) Is Nothing Then
        MsgBox "Select a cell in table '" & slo.Name & "'.", vbExclamation
        Exit Sub
    End If
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Sheet2")
    Dim dlo As ListObject: Set dlo = dws.ListObjects("Table2")
    Dim drg As Range: Set drg = dlo.Range

    Dim r As Long: r = sCell.Row - srg.Row   1
    Dim c As Long: c = sCell.Column - srg.Column   1
    
    Dim dCell As Range: Set dCell = drg.Cells(r, c)
        
    Debug.Print r, c, sCell.Address, dCell.Address
    
End Sub