+ Reply to Thread
Results 1 to 4 of 4

macro copy/paste lists data from multiple sheets to one comparison sheet

Hybrid View

johnnieboi89 macro copy/paste lists data... 06-29-2011, 09:39 AM
tigeravatar Re: macro copy/paste lists... 06-29-2011, 11:54 AM
johnnieboi89 Re: macro copy/paste lists... 06-29-2011, 03:10 PM
johnnieboi89 Re: macro copy/paste lists... 06-29-2011, 04:22 PM
  1. #1
    Registered User
    Join Date
    06-27-2011
    Location
    USA
    MS-Off Ver
    Excel 2007
    Posts
    10

    Cool macro copy/paste lists data from multiple sheets to one comparison sheet

    I have a workbook that uses multiple sheets. I am trying to make one sheet that compares the different data.
    On the sheet that compares the different data I was wanting to create a macro that once you click a field in the combo box the relative data pops up on the screen. I also want the macro to auto matically line the data up side by dside
    I have been successful with this macro (with the help of this forum) to pull data from a single page. However, I need this macro to work for all of the pages in my workbook.

    Here is the macro that I used to make the combo box work for pulling data from a single work sheet
    
    Sub DropDown2_Change()
        
        Const FirstCell As String = "B1"
        
        Dim rngDest As Range: Set rngDest = ActiveSheet.Range(FirstCell)
        Dim ddn_Code As DropDown
        Dim rngCodes As Range
        Dim ChosenCode As String
        Dim rngFound As Range
        
        Set ddn_Code = ActiveSheet.DropDowns(Application.Caller)
        Set rngCodes = Sheets("Sheet1").Range("B1", Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft))
        ChosenCode = ddn_Code.List(ddn_Code.Value)
        
        Set rngFound = rngCodes.Find(LCase(Trim(ChosenCode)))
        If rngFound Is Nothing Then Exit Sub
        Set rngFound = rngFound.Offset(1, 0).Resize(rngFound.CurrentRegion.Rows.Count - 1, 1)
        
        If rngDest.Value = vbNullString Then
            rngDest.Resize(rngFound.Rows.Count, 1).Value = rngFound.Value
        Else
            Set rngDest = ActiveSheet.Cells(rngDest.Row, Columns.Count).End(xlToLeft).Offset(0, 1)
            rngDest.Resize(rngFound.Rows.Count, 1).Value = rngFound.Value
        End If
        
    End Sub
    And here is the code that didnt work when pulling from multiple sheets.

      Sub DropDown2_Change()
        
        Const FirstCell As String = "B1"
        
        Dim rngDest As Range: Set rngDest = ActiveSheet.Range(FirstCell)
        Dim ddn_Code As DropDown
        Dim rngCodes As Range
        Dim ChosenCode As String
        Dim rngFound As Range
        
        Set ddn_Code = ActiveSheet.DropDowns(Application.Caller)
        Set rngCodes = Sheets("Total Annual").Range("B1", Sheets("Total Annual").Cells(1, Columns.Count).End(xlToLeft))
        Set rngCodes = Sheets("LH Annual").Range("B1", Sheets("LH Annual").Cells(1, Columns.Count).End(xlToLeft))
        Set rngCodes = Sheets("PC Annual").Range("B1", Sheets("PC Annual").Cells(1, Columns.Count).End(xlToLeft))
        Set rngCodes = Sheets("Reinsurance").Range("B1", Sheets("Reinsurance").Cells(1, Columns.Count).End(xlToLeft))
        Set rngCodes = Sheets("Quarterly AM Best").Range("B1", Sheets("Quarterly AM Best").Cells(1, Columns.Count).End(xlToLeft))
        Set rngCodes = Sheets("Annual AM Best").Range("B1", Sheets("Annual AM Best").Cells(1, Columns.Count).End(xlToLeft))
        ChosenCode = ddn_Code.List(ddn_Code.Value)
        
        Set rngFound = rngCodes.Find(LCase(Trim(ChosenCode)))
        If rngFound Is Nothing Then Exit Sub
        Set rngFound = rngFound.Offset(1, 0).Resize(rngFound.CurrentRegion.Rows.Count - 1, 1)
        
        If rngDest.Value = vbNullString Then
            rngDest.Resize(rngFound.Rows.Count, 1).Value = rngFound.Value
        Else
            Set rngDest = ActiveSheet.Cells(rngDest.Row, Columns.Count).End(xlToLeft).Offset(0, 1)
            rngDest.Resize(rngFound.Rows.Count, 1).Value = rngFound.Value
        End If
        
    End Sub
    I am also attaching the document that I am trying to run the macro in.

    here is a link to my previous thread about the same issue:

    http://www.excelforum.com/excel-prog...o-another.html
    Last edited by johnnieboi89; 07-05-2011 at 02:23 PM. Reason: solved

  2. #2
    Forum Expert tigeravatar's Avatar
    Join Date
    03-25-2011
    Location
    Colorado, USA
    MS-Off Ver
    Excel 2003 - 2013
    Posts
    5,361

    Re: macro copy/paste lists data from multiple sheets to one comparison sheet

    johnnieboi89,

    I already posted this solution in the other thread, but here it is again. All of the items can be found in one of the following 2 worksheets: 'Quarterly AM Best' and 'Annual AM Best' so there is no need to include the other sheets. Here's the updated code:
    Sub DropDown1_Change()
        
        Const FirstCell As String = "B1"
        
        Dim rngDest As Range: Set rngDest = ActiveSheet.Range(FirstCell)
        Dim ddn_Code As DropDown
        Dim rngCodes As Range
        Dim ChosenCode As String
        Dim rngFound As Range
        
        Dim ws1 As Worksheet: Set ws1 = Sheets("Quarterly AM Best")
        Dim ws2 As Worksheet: Set ws2 = Sheets("Annual AM Best")
        
        Set ddn_Code = ActiveSheet.DropDowns(Application.Caller)
        ChosenCode = ddn_Code.List(ddn_Code.Value)
        
        Set rngCodes = ws1.Range("C1", ws1.Cells(1, Columns.Count).End(xlToLeft))
        Set rngFound = rngCodes.Find(LCase(Trim(ChosenCode)))
        If rngFound Is Nothing Then
            Set rngCodes = ws2.Range("C1", ws2.Cells(1, Columns.Count).End(xlToLeft))
            Set rngFound = rngCodes.Find(LCase(Trim(ChosenCode)))
        End If
        Set rngFound = rngFound.Offset(1, 0).Resize(rngFound.CurrentRegion.Rows.Count - 1, 1).SpecialCells(xlCellTypeConstants)
        
        If rngDest.Value = vbNullString Then
            rngDest.Resize(rngFound.Rows.Count, 1).Value = rngFound.Value
        Else
            Set rngDest = ActiveSheet.Cells(rngDest.Row, Columns.Count).End(xlToLeft).Offset(0, 1)
            rngDest.Resize(rngFound.Rows.Count, 1).Value = rngFound.Value
        End If
        
    End Sub


    Hope that helps,
    ~tigeravatar

  3. #3
    Registered User
    Join Date
    06-27-2011
    Location
    USA
    MS-Off Ver
    Excel 2007
    Posts
    10

    Re: macro copy/paste lists data from multiple sheets to one comparison sheet

    There is also information onLH Annual, Pc, Annual, Total annual, and reinsurance. I cant get the code to work for those pages. Nor can I get the fields that have more than 5 rows of data to show all of the data in the list.

    Jhnnieboi89

  4. #4
    Registered User
    Join Date
    06-27-2011
    Location
    USA
    MS-Off Ver
    Excel 2007
    Posts
    10

    Re: macro copy/paste lists data from multiple sheets to one comparison sheet

    Ok i understand what you ment macro works beautifully. Sorry for the confusion
    Job well done

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1