VBA - Results Populating Outside Excel Table

MishTaylor

New Member
Joined
May 4, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Hi Everyone,

I need some help with my code to reference the table properly. Right now, when I run this code, the data populates outside of the table - not sure how to reference the table correctly.

Table = "PrevReport"
Sheet = "Print Reports"
The data is being filtered by date range from another sheet called "Packaged&Restock"

Thanks!

VBA Code:
Private Sub PreviewBtn_Click()
Dim i As Long
Dim startdate As Date
Dim enddate As Date
Dim ws As Worksheet
Set RTAB = ws.ListObjects("PrevReport")
Set REP = ThisWorkbook.Sheets("PrintReports")
Set TOT = ThisWorkbook.Sheets("Packaged&Restock")
Application.ScreenUpdating = False

startdate = REP.Range("H2").Value
enddate = REP.Range("I2").Value


RTAB.Range("A" & 11, "I" & 100000).ClearContents

For i = 2 To TOT.Range("A100000").End(xlUp).Row

    If TOT.Cells(i, 1) >= startdate And _
    TOT.Cells(i, 1) <= enddate Then

RTAB.Range("A100000").End(xlUp).Offset(1, 0) = TOT.Cells(i, 1)
For x = 1 To 10
RTAB.Range("A100000").End(xlUp).Offset(0, x) = TOT.Cells(i, x + 1)
Next x


End If
Next i

End Sub

1620663867028.png
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Does this get you closer to what you are trying to do...

VBA Code:
Private Sub PreviewBtn_Click()

    Dim i As Long, x As Long
    Dim startdate As Date, enddate As Date
    Dim ws As Worksheet, REP As Worksheet, TOT As Worksheet
    Dim RTAB As Object
    
    Set REP = ThisWorkbook.Sheets("PrintReports")
    Set RTAB = REP.ListObjects("PrevReport")
    Set TOT = ThisWorkbook.Sheets("Packaged&Restock")
    Application.ScreenUpdating = False

    startdate = REP.Range("H2").Value
    enddate = REP.Range("I2").Value

    With RTAB.DataBodyRange
        If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
        End If
    End With
    
    For i = 2 To TOT.Range("A100000").End(xlUp).Row
        If TOT.Cells(i, 1) >= startdate And TOT.Cells(i, 1) <= enddate Then
            RTAB.DataBodyRange(i, 1) = TOT.Cells(i, 1)
            For x = 2 To 10
                RTAB.DataBodyRange(i, x) = TOT.Cells(i, x + 1)
            Next x
        End If
    Next i
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
Errant post
Hi! Thanks so much this does work! The only problem is if the table is empty then it won't update because this is only if there is data in it. Anyway to change the IF statement to always clear the table?
Thanks!!!!

VBA Code:
  With RTAB.DataBodyRange
        If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
        End If
    End With
 
Upvote 0
Is this any better...

VBA Code:
Private Sub PreviewBtn_Click()

    Dim i As Long, x As Long
    Dim startdate As Date, enddate As Date
    Dim ws As Worksheet, REP As Worksheet, TOT As Worksheet
    Dim RTAB As Object
    
    Set REP = ThisWorkbook.Sheets("PrintReports")
    Set RTAB = REP.ListObjects("PrevReport")
    Set TOT = ThisWorkbook.Sheets("Packaged&Restock")
    Application.ScreenUpdating = False

    startdate = REP.Range("H2").Value
    enddate = REP.Range("I2").Value

    If RTAB.ListRows.Count > 1 Then
        RTAB.DataBodyRange.Delete
    End If
    
    RTAB.ListRows.Add AlwaysInsert:=True
    
    For i = 2 To TOT.Range("A100000").End(xlUp).Row
        If TOT.Cells(i, 1) >= startdate And TOT.Cells(i, 1) <= enddate Then
            RTAB.DataBodyRange(i, 1) = TOT.Cells(i, 1)
            For x = 2 To 10
                RTAB.DataBodyRange(i, x) = TOT.Cells(i, x + 1)
            Next x
        End If
    Next i
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
Solution
Additionally, here is a nice reference for working with tables:

 
Upvote 0
Is this any better...

VBA Code:
Private Sub PreviewBtn_Click()

    Dim i As Long, x As Long
    Dim startdate As Date, enddate As Date
    Dim ws As Worksheet, REP As Worksheet, TOT As Worksheet
    Dim RTAB As Object
   
    Set REP = ThisWorkbook.Sheets("PrintReports")
    Set RTAB = REP.ListObjects("PrevReport")
    Set TOT = ThisWorkbook.Sheets("Packaged&Restock")
    Application.ScreenUpdating = False

    startdate = REP.Range("H2").Value
    enddate = REP.Range("I2").Value

    If RTAB.ListRows.Count > 1 Then
        RTAB.DataBodyRange.Delete
    End If
   
    RTAB.ListRows.Add AlwaysInsert:=True
   
    For i = 2 To TOT.Range("A100000").End(xlUp).Row
        If TOT.Cells(i, 1) >= startdate And TOT.Cells(i, 1) <= enddate Then
            RTAB.DataBodyRange(i, 1) = TOT.Cells(i, 1)
            For x = 2 To 10
                RTAB.DataBodyRange(i, x) = TOT.Cells(i, x + 1)
            Next x
        End If
    Next i
    Application.ScreenUpdating = True

End Sub
Hi! Thanks so much this is working now but I'm getting an additional empty row in the beginning of my table now - I can filter it out but wondering why that's happening.
 
Upvote 0
Additionally, here is a nice reference for working with tables:

This is so helpful thanks for sharing!!
 
Upvote 0
You are welcome, I am happy to help.

Truthfully, I have worked with tables pretty often, I also got that same blank row which I found to be weird. I could not pin it down so I sent what I had. I plan to (for myself and for the sake of this post) try to figure out why that is happening. I have a feeling it has to do with your For/Next loop starting with "i = 2", but when I played with that, the code puked.

I will stay with it and post a solution if I find one.

Thanks for the feedback.
 
Upvote 0
As a workaround, you could add this line as your last line of code...

VBA Code:
  RTAB.ListRows(1).Delete

Also, I don't have your data but this code is not picking up row 2 of my mock-up of your "Packaged&Restock" sheet. I don't know if that is what you intended...
 
Upvote 0

Forum statistics

Threads
1,215,343
Messages
6,124,404
Members
449,156
Latest member
LSchleppi

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