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
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Maybe this:
Code:
wsTar.ListObjects("Table1").Range.Delete
 
Upvote 0

Forum statistics

Threads
1,214,915
Messages
6,122,214
Members
449,074
Latest member
cancansova

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top