Automatically copy range of cells to cells of same sheet

[toant]

Hi. I would sort by categories a range of cells to sub tables on the same sheet. I have attached a few pictures as examples to better explain my scenario. Please note "x" are just placeholders fields that some text will be entered later.

Criteria:

1) Automatically place each Item and range from Item==>Quantity it to each corresponding category "sub table" on the same sheet (i.e. all ice cream goes together and all Fruit goes together)
2) Any duplicate Items will not have another line but rather be combined and quantity added (note: highlighted quantity is just for reference that the quantity has been added)
3) If an Item is removed from the main table, it will automatically be removed from the sub table or substracted from the quantity.

Any help is appreciated. I would prefer not to use Macros for this.

Thank you in advance.

 

[toant]

Any help would be appreciated. I believe a vba code works for this?

 

[mumps]

It is hard to work with a picture. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

If an Item is removed from the main table, it will automatically be removed from the sub table or substracted from the quantity.

Please explain what you mean by this in detail using a few examples from your data.

 

[toant]

Dropbox:

Freezer .xlsx

Shared with Dropbox

www.dropbox.com

For Criteria #3 above, I mean if the value updated in the main table it should also be reflected in the subtables. So if the value for ice cream was there before and later became 0 then the subtable should not show a value

Thanks!

 

[mumps]

Why does Freezer 4 not have the two column headers with an "x"? Do you want to exclude the categories and items in Freezer 4? Please clarify in detail. Will each of the "Shelf" sections always contain 10 rows for categories and items?

 

[mumps]

Click here to download your file. Please note that the macros in the file are based on the sample file you posted. If you modify the file in any way, the macros may not work properly. Run the macro in Module1. Also, there are 2 event macros in the worksheet code module. To view these 2 macros, right click the sheet name and click "View Code". These 2 macros allow you to change the quantities in your main table and update the corresponding quantities in the category tables at the bottom. If any of the quantities in the category tables become zero, those categories will be deleted.

 

[Fluff]

@mumps please post your solution to the board, so that members do not need to download files. Thanks

 

[mumps]

@Fluff
My apologies.

In the worksheet code module:

Dim oldVal As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("F:F,K:K,P:P")) Is Nothing Then Exit Sub
    oldVal = Target.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lastRow As Long, cat As Range
    lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Target.CountLarge > 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Intersect(Target, Range("F:F,K:K,P:P")) Is Nothing Then Exit Sub
    Set cat = Range("C72:M" & lastRow).Find(Target.Offset(, -3), LookIn:=xlValues, lookat:=xlWhole)
    If Not cat Is Nothing Then
        cat.Offset(, 3).Value = cat.Offset(, 3).Value - oldVal + Target.Value
        If cat.Offset(, 3).Value = 0 Then
            cat.Resize(, 4).Delete shift:=xlUp
        End If
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

In a regular module:

Sub CopyCells()
    Application.ScreenUpdating = False
    Dim lastRow As Long, lRow As Long, lCol As Long, cat As Range, fndCat As Range, item As Range, fndItem As Range, x As Long, fRow As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row + 9
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 11
    lCol = Cells(3, Columns.Count).End(xlToLeft).Column
    For x = 2 To lCol Step 5
        If Cells(4, x) <> "" Then
            For Each cat In Range(Cells(4, x).Address).Resize(lastRow - 3).SpecialCells(xlCellTypeConstants)
                Set fndCat = Range("C70:S" & lRow).Find(cat, LookIn:=xlValues, lookat:=xlWhole)
                If Not fndCat Is Nothing Then
                    fRow = Range(Cells(fndCat.Row + 1, fndCat.Column), Cells(lRow, fndCat.Column)).SpecialCells(xlCellTypeBlanks).Row
                    Set fndItem = Range(Cells(fndCat.Row + 1, fndCat.Column), Cells(lRow, fndCat.Column)).Find(cat.Offset(, 1), LookIn:=xlValues, lookat:=xlWhole)
                    If fndItem Is Nothing Then
                        Cells(fRow, fndCat.Column).Resize(, 4).Value = cat.Offset(, 1).Resize(, 4).Value
                    Else
                        Cells(fndItem.Row, fndCat.Column + 3).Value = Cells(fndItem.Row, fndCat.Column + 3).Value + cat.Offset(, 4).Value
                    End If
                End If
            Next cat
        End If
    Next x
    Application.ScreenUpdating = True
End Sub

 

[toant]

Click here to download your file. Please note that the macros in the file are based on the sample file you posted. If you modify the file in any way, the macros may not work properly. Run the macro in Module1. Also, there are 2 event macros in the worksheet code module. To view these 2 macros, right click the sheet name and click "View Code". These 2 macros allow you to change the quantities in your main table and update the corresponding quantities in the category tables at the bottom. If any of the quantities in the category tables become zero, those categories will be deleted.

@mumps Thanks for helping with this. Just curious if there is any way to achieve the same results with out the use of Macros. Ideally I would like it to just update/copy real-time without having to run a macro. Reason being multiple people will be updating this sheet and may not know or remember to run a macro. Thanks!

 

[Fluff]

What version of Excel are you using?

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Also are you happy to change the layout of your data?