Populate table from another table based on drop down list selection

Ashleimo

New Member
Joined
Dec 4, 2017
Messages
11
Essentially what I am trying to do is copy a table from one worksheet to another based on a selection from a drop down list. I would like for each time the drop down option is changed the table is changed.

For example:
Worksheet1
A1=Quarter 1 (Chosen from drop down list)

A2= Table named Quarter 1 pulls from Worksheet 2

Hopefully that is clear. I'm open to all options!
 
@Ashleimo
Cross-Posting
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.
 
Upvote 0

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Some how last two lines of my script got cut off.

Try this:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 3-30-18 6:45 PM EDT
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.ScreenUpdating = False
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim ans As String
ans = Target.Value
Dim TT As ListObject
ans = Target.Value
    For i = 1 To Sheets.Count
    
        With Sheets(i)
            For Each TT In Sheets(i).ListObjects
                If TT.Name = ans Then TT.Range.Copy Sheets(1).Range("B1"): Exit Sub
                    
            Next
        End With
    Next
Application.ScreenUpdating = True
End If
End Sub
 
Upvote 0
Some how last two lines of my script got cut off.

Try this:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 3-30-18 6:45 PM EDT
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.ScreenUpdating = False
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim ans As String
ans = Target.Value
Dim TT As ListObject
ans = Target.Value
    For i = 1 To Sheets.Count
    
        With Sheets(i)
            For Each TT In Sheets(i).ListObjects
                If TT.Name = ans Then TT.Range.Copy Sheets(1).Range("B1"): Exit Sub
                    
            Next
        End With
    Next
Application.ScreenUpdating = True
End If
End Sub



Thank you for your help! I think I may just not be experienced enough to get that to work. Once I run it, nothing happens. I'm not getting an error or anything, just nothing happens.
 
Upvote 0
So your saying you entered a Table name in range "A1" of the sheet where you entered my script and nothing happened. And your sure you entered a proper table name.

Well here i added a popup message that will popup letting you know the script is running then when you click Ok the script will continue to run. If nothing happens after that it's because the script found no table by that name.

Here try this script.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 4-3-18 6:40 PM EDT
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.ScreenUpdating = False
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
MsgBox "Hello now I will look for a Table named  " & Target.Value
Dim ans As String
Dim x As Long
x = 0
ans = Target.Value
Dim TT As ListObject
ans = Target.Value
    For i = 1 To Sheets.Count
    
        With Sheets(i)
            For Each TT In Sheets(i).ListObjects
                If TT.Name = ans Then TT.Range.Copy Sheets(1).Range("B1"): x = x + 1: Exit Sub
                    
            Next
        End With
    Next
    If x = 0 Then MsgBox "I found no table named  " & Target.Value
Application.ScreenUpdating = True
End If
End Sub
 
Upvote 0
So your saying you entered a Table name in range "A1" of the sheet where you entered my script and nothing happened. And your sure you entered a proper table name.

Well here i added a popup message that will popup letting you know the script is running then when you click Ok the script will continue to run. If nothing happens after that it's because the script found no table by that name.

Here try this script.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 4-3-18 6:40 PM EDT
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.ScreenUpdating = False
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
MsgBox "Hello now I will look for a Table named  " & Target.Value
Dim ans As String
Dim x As Long
x = 0
ans = Target.Value
Dim TT As ListObject
ans = Target.Value
    For i = 1 To Sheets.Count
    
        With Sheets(i)
            For Each TT In Sheets(i).ListObjects
                If TT.Name = ans Then TT.Range.Copy Sheets(1).Range("B1"): x = x + 1: Exit Sub
                    
            Next
        End With
    Next
    If x = 0 Then MsgBox "I found no table named  " & Target.Value
Application.ScreenUpdating = True
End If
End Sub


I had to walk away from this project for a bit but I was finally able to get this to work! Thank you so much for your help!
 
Upvote 0
Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.
 
Upvote 0
One last question. If there are formulas in the table being pulled, is there a way I can break the formula and only pull the data in the cell? Once I applied your solution, it is pulling the table beautifully, all my formatting is correct, but is giving me a #ref ! in each cell.
 
Upvote 0
Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

One last question. If there are formulas in the table being pulled, is there a way I can break the formula and only pull the data in the cell? Once I applied your solution, it is pulling the table beautifully, all my formatting is correct, but is giving me a #ref ! in each cell.
 
Upvote 0
Try this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 5-24-18 6:45 PM EDT
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.ScreenUpdating = False
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
MsgBox "Hello now I will look for a Table named  " & Target.Value
Dim ans As String
Dim x As Long
x = 0
ans = Target.Value
Dim TT As ListObject
ans = Target.Value
    For i = 1 To Sheets.Count
    
        With Sheets(i)
            For Each TT In Sheets(i).ListObjects
                If TT.Name = ans Then
                TT.Range.Copy
                Sheets(1).Range("B1").PasteSpecial xlValues
                Sheets(1).Range("B1").PasteSpecial Paste:=xlPasteFormats: x = x + 1
                 Exit Sub
                 End If
                 
            Next
        End With
    Next
    If x = 0 Then MsgBox "I found no table named  " & Target.Value
Application.ScreenUpdating = True
End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,938
Messages
6,127,777
Members
449,406
Latest member
Pavesib

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