Excel VBA:  Copy data from one worksheet to another based on selected criteria in a combobox

Posted on 2012-09-07
Medium Priority
Last Modified: 2012-09-07
Hi Experts,

The set up:
I have a worksheet which I'll refer to as "Snapshot" that has a combobox in cell "A2" using data validation with a list of Supervisors.  

Also in the "Snapshot" worksheet the 1st Row is the header "B1:Z1" who's naming convention matches my 2nd worksheet's (known as "Agent") header exactly accept the "Agent" worksheet's header row starts at "A1:Y1" (1st 3 columns contain = "A" Manager's Names, "B" Supervisor's Names, and "C" Agent's names respectively).

What I would like to do:  
Based on the selected criteria in the combobox of "Snapshot" I would like to be able to COPY data from "Agent" range "A2:Y500" and have the rows of data pasted into columns "B:Z" on "Snapshot".  

For example:  If on "Snapshot" supervisor "TestSup_A" is selected then I would like to find "TestSup_A" name in column "B" of the "Agent" worksheet and bring back all of his or her agent data to the "Snapshot" worksheet.  Bringing back "TestSup_A" Manager and Agent alignment as well something similar to an "index-match" formula.

Sample Workbook attached .

Thank you!  :)
Question by:"Abys" Wallace
LVL 93

Accepted Solution

Patrick Matthews earned 2000 total points
ID: 38377230
The following appears to be working for me.  It goes on the code module for the Snapshot worksheet.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LastRSource As Long, LastRDest As Long
    Dim Source As Worksheet
    If Not Intersect(Target, Me.[a2]) Is Nothing Then
        Application.EnableEvents = False
        With Me
            LastRDest = .Cells(.Rows.Count, "b").End(xlUp).Row
            If LastRDest > 1 Then
                With .Range("b2:z" & LastRDest)
                    .Interior.ColorIndex = xlColorIndexNone
                End With
            End If
            Set Source = ThisWorkbook.Worksheets("Agent")
            With Source
                LastRSource = .Cells(.Rows.Count, "a").End(xlUp).Row
            End With
            Source.Range("a1").AutoFilter 2, .[a2], xlAnd
            On Error Resume Next
            Source.Range("a2:y" & LastRSource).SpecialCells(xlCellTypeVisible).Copy .[b2]
            On Error GoTo 0
        End With
        Application.EnableEvents = True
    End If
End Sub

Open in new window


Author Closing Comment

by:"Abys" Wallace
ID: 38378353
Thank you.. that worked perfectly ...

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

621 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question