• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Creating dynamic summaries

onklus

New Member
I have a summary sheet which contains multiple recipes for multiple items. The sheet is structured as such:


Parent item Component item # Qty required

Item # 1 Component # 1 0.5

Item # 1 Component # 12 6

.....

Item # 26 Component # 3 12

Item # 26 Component # 1 2


I'd like to create a summary sheet that will pull from my data sheet and allow me to present the recipe for a particular item (and only that item) when I select the desired item # from a drop down list.


The recipes can have different numbers of components so I need the summary to be flexible enough to handle this.


Any ideas would be greatly appreciated.
 
Hi Onklus,


Below is a macro that you can Run.


It assumes that you have 2 sheets "Summary" and "Data"


"Data" has a header and the Item # is in column A starting on column 2

"Summary" has the required Item to be searched for in A1.


Sub FilterCopy()


Dim Item As Integer


Sheets("Summary").Select

Item = Range("A1")


Sheets("Data").Select

Range("A1").Select

Selection.AutoFilter

Selection.AutoFilter

ActiveSheet.Range("A:B").AutoFilter Field:=1, Criteria1:=Item

Range("A1").Select

Selection.CurrentRegion.Select

Selection.Offset(1, 0).Select

Selection.Copy Sheets("Summary").Range("A3")


End Sub
 
You can use either:


1) AutoFilter, Setup a table and apply filter criteria in place


2) Array Formula, use something like `=IF(ISERROR(SMALL(IF(Sheet1!$B$2:$B$20>2,ROW(Sheet1!$B$2:$B$20)),ROW(A1))),"",

INDEX(Sheet1!$A:$A,SMALL(IF(Sheet1!$B$2:$B$20>2,ROW(Sheet1!$B$2:$B$20)),ROW(A1)))) `


3) setup a report area and extract with formulas. Refer these examples:

http://rapidshare.com/files/430489122/Sorter__Dates_.xls

or

http://rapidshare.com/files/427379371/Sorter.xls
 
Thanks Kchiba.


The macro you suggested almost gets me to where I need to get...just 3 issues:


1) I want a user to be able to change the required Item to be searched for (Cell A1 on the Summary) tab by selecting from a drop-down. I can easily add the drop down, but how do I get the macro to automatically update each time a new item is selected?


2)When I do select a new item to be searched and rerun the macro (manually) if the new item selected has less components than the previous selected item then I still see some of the components of the previous selected item in my listing.


3) Once the macro finishes running it opens the 'Data' tab as the active sheet. Is there a way for it to stay on the 'Summary' sheet?


Thanks so much!
 
Hi Onklus,


Place the following VBA code in the code for the summary sheet.


I must thanks OZGrid.Com for the wrapper around the code and Contexture.Com for the Autofilter switch.


Note this code assumes that Item is numeric. I have not coded the dropdown for cell A1, you should try Data Validation for that.


Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub


If Target.Address = "$A$1" Then


If IsNumeric(Target) Then


On Error Resume Next


Sheets("Summary").Activate

Range("A3").Select

Selection.CurrentRegion.Select

Selection.ClearContents

Item = Range("A1")

Sheets("Data").Activate

Range("A1").Select

If ActiveSheet.FilterMode Then

ActiveSheet.ShowAllData

End If

Selection.AutoFilter

ActiveSheet.Range("A:B").AutoFilter Field:=1, Criteria1:=Item

Range("A1").Select

Selection.CurrentRegion.Select

Selection.Offset(1, 0).Select

Selection.Copy Sheets("Summary").Range("A3")

Sheets("Summary").Activate


Application.EnableEvents = False

Application.EnableEvents = True


On Error GoTo 0


End If

End If


End Sub


Cheers


Kanti
 
Thank Kanti....Almost there.


I'm getting an error that reads 'Argument not optional'


I modified the code slightly to reflect some changes to where I want the data placed on the sheet and where I placed the drop-down


"Data" has a header and the Item # is in column A starting on Line 1

"Summary" has the required Item to be searched for in N5.

The data is to be placed on the Summary tab starting on cell A16


Code is:


Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub


If Target.Address = "$N$5" Then


If IsNumeric(Target) Then


On Error Resume Next


Sheets("Summary").Activate

Range("A16").Select

Selection.CurrentRegion.Select

Selection.ClearContents

Item = Range("N5")

Sheets("Data").Activate

Range("A1").Select

If ActiveSheet.FilterMode Then

ActiveSheet.ShowAllData

End If

Selection.AutoFilter

ActiveSheet.Range("A:B").AutoFilter Field:=1, Criteria1:=Item

Range("A1").Select

Selection.CurrentRegion.Select

Selection.Offset(1, 0).Select

Selection.Copy Sheets("Summary").Range("A16")

Sheets("Summary").Activate


Application.EnableEvents = False

Application.EnableEvents = True


On Error GoTo 0


End If

End If


End Sub
 
Hi Onklus,


I have tested the changes you have made and the Macro works fine I am not getting any error.


kanti
 
Thanks...figured out the error.


However, when I select and item that has less components than the previous item I selected it's still not clearing all of the lines in the summary....Any ideas as to why this is still occuring?


Also, the code assumes the Item is numeric - Is there a way to modify this for non-numeric values. Some of the Item numbers have letters and other characters. I tried "IsText" but that didn't work.


Thanks for all of your help
 
Hi Onklus,


try these changes


Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

If Target.Address = "$N$5" Then

' If IsNumeric(Target) Then

On Error Resume Next

Application.EnableEvents = False

Sheets("Summary").Activate

Range("A16").CurrentRegion.ClearContents

Item = Range("N5")

Sheets("Data").Activate

If ActiveSheet.FilterMode Then

ActiveSheet.ShowAllData

End If

Range("A1").Select

Selection.AutoFilter

ActiveSheet.Range("A:B").AutoFilter Field:=1, Criteria1:=Item

Range("A1").Select

Selection.CurrentRegion.Offset(1, 0).Copy Sheets("Summary").Range("A16")

Sheets("Summary").Activate

Range("A1").Select

Application.EnableEvents = True


On Error GoTo 0

' End If

End If

End Sub
 
Thanks so much for your help...

Unfortunately it's still not zeroing out the previous item (when the previous item contains more components).


I've been playing around with the code all day and can't seem to crack this one detail.
 
Hi Onklus,


It works OK for me, the first result is placed in cell A16,


If the first selected Item has 4 rows and the second has 2 rows it only shows 2 rows the second time round


kanti
 
I got it...must have had something wrong so just started from scratch and it worked


Thanks so much for your help! Very much appreciated!
 
Back
Top