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
Bookmarks