Range From Table in VBA

L

Legacy 436357

Guest
Hi,

This code references "Table 1". I want to make that a range instead. I can do that converting to range but don't know how to alter the code to reference the range. Does anyone know how?

The range is O2:Q23 on the AFRsInput sheet. Row 2 has the column headers.

Thank you so much,
XJ

Code:
Sub PopulateForm()
    With ThisWorkbook
        Dim myPass As String: myPass = "password"
        Dim myPassRequest As String
        Dim myAnswer As Integer
        Dim rng As Range
        Dim rng2 As Range
        Dim i As Integer
        Dim wsSrc1 As Worksheet:    Set wsSrc1 = .Sheets("AFRsDB")
        Dim wsSrc2 As Worksheet:    Set wsSrc2 = .Sheets("AFRsParts")
        Dim wsTar As Worksheet:     Set wsTar = .Sheets("AFRsInput"):   wsTar.Unprotect "pass"
        Dim lngAFR As Long:         lngAFR = wsTar.Range("D4").Value
        Dim lngRow As Long
        Dim lngSrc2LR As Long
        Dim NewTblRow As ListRow
        
        If Worksheets("AFRsInput").Range("D4").Value = vbNullString Then
            Worksheets("AFRsInput").Range("D4:D18").ClearContents
            Worksheets("AFRsInput").Range("H4:H18").ClearContents
            Worksheets("AFRsInput").Range("L4").MergeArea.ClearContents
            Worksheets("AFRsInput").Range("L7").MergeArea.ClearContents
            Worksheets("AFRsInput").Range("L10").MergeArea.ClearContents
            Worksheets("AFRsInput").Range("L13").MergeArea.ClearContents
            Worksheets("AFRsInput").Range("L19").MergeArea.ClearContents
            On Error Resume Next
            wsTar.ListObjects("Table1").DataBodyRange.Delete
            On Error GoTo 0
            GoTo end_the_sub:
        End If
        
        Set rng = wsSrc1.Range("C:C").Find(lngAFR, , xlValues, xlWhole)
        If Not rng Is Nothing Then
            lngRow = rng.Row
            For i = 3 To 37
                Set rng2 = wsTar.Range("B4:J19").Find(wsSrc1.Cells(1, i).Value)
                rng2.Offset(0, 2) = wsSrc1.Cells(lngRow, i)
            Next i
                    
            On Error Resume Next
            wsTar.ListObjects("Table1").DataBodyRange.Delete
            On Error GoTo 0
            With wsSrc2
                lngSrc2LR = .Cells(Rows.Count, "A").End(xlUp).Row
                For i = 3 To lngSrc2LR
                    If .Cells(i, "C") = lngAFR Then
                        Set NewTblRow = wsTar.ListObjects("Table1").ListRows.Add
                        'NewTblRow.Range(1) = .Cells(i, "C")
                        NewTblRow.Range(1) = .Cells(i, "D")
                        NewTblRow.Range(2) = .Cells(i, "E")
                        NewTblRow.Range(3) = .Cells(i, "F")
                    End If
                Next i
            End With
        Else
            myAnswer = MsgBox("Are you sure you want to add this new AFR#?", vbYesNo)
            If myAnswer <> vbYes Then Exit Sub
            myPassRequest = InputBox("Please enter the password to verify the new AFR #")
            If myPassRequest <> myPass Then
                MsgBox ("Sorry, that password is incorrect")
                Worksheets("AFRsInput").Range("D4").Value = vbNullString
                GoTo end_the_sub:
            Else
                MsgBox ("New AFR # accepted.")
                Sheets("AFRsInput").Range("D4").Value = Sheets("AFRsInput").Range("D4").Value
                
                With ThisWorkbook.Sheets("AFRsInput")
                    .Range("D5:D18,H4:H18").ClearContents
                    .Cells(4, "L").MergeArea.ClearContents
                    .Cells(7, "L").MergeArea.ClearContents
                    .Cells(10, "L").MergeArea.ClearContents
                    .Cells(13, "L").MergeArea.ClearContents
                    .Cells(19, "L").MergeArea.ClearContents
                On Error Resume Next
                    .ListObjects("Table1").DataBodyRange.Delete
                On Error GoTo 0
                End With

                
                
            End If
        End If
    End With
end_the_sub:
wsTar.Protect "pass"

End Sub
 

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,575
Office Version
  1. 365
Platform
  1. Windows
Maybe this:
Code:
wsTar.ListObjects("Table1").Range.Delete
 

Watch MrExcel Video

Forum statistics

Threads
1,108,790
Messages
5,524,893
Members
409,609
Latest member
Channingz

This Week's Hot Topics

Top