Macro to sort and paste data in specific cells

@planbms

Welcome to the forum.

Put the code into a standard module in the Volume.xls wbook. Having tested the code then checked some of the results I can understand your frustration with the task.

This is one way, there may well be formulas that can do the same job but this works for me. Let me know how you get on.

Option Explicit

Sub GetCases()

    Dim wsUGVol As Worksheet, wsBorden As Worksheet
    Dim iFirstRowVol As Integer
    Dim sFirstAddress As String
    Dim nRowCount As Long
    Dim rUGVol As Range, tblUGVol As Range, rUGItemVol As Range, tblUGItemVol As Range
    Dim rUGIdFoundBorden As Range, tblUGBorden As Range, tblUGItemBorden As Range
    Dim nMatch As Long

    Set wsBorden = Workbooks("ADB.xls").Sheets("Bordon Sales 2012")
    With wsBorden
        Set tblUGBorden = .Range(.Cells(1, "A"), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, "A"))   ''' col A Borden Sales
    End With

    Set wsUGVol = ThisWorkbook.Sheets("UG VOLUME REPORT APR 2012")
    With wsUGVol
        iFirstRowVol = 4
        Set tblUGVol = .Range(.Cells(iFirstRowVol, "A"), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, "A"))   ''' col A Volume
        Set tblUGItemVol = .Range(.Cells(3, "C"), .Cells(3, .Cells(3, .Columns.Count).End(xlToLeft).Column))    ''' row 3 Volume

        For Each rUGVol In tblUGVol
            nRowCount = 0
            Set rUGIdFoundBorden = tblUGBorden.Find(rUGVol, , xlValues, xlWhole, xlRows, xlNext, False)
            If Not rUGIdFoundBorden Is Nothing Then
                sFirstAddress = rUGIdFoundBorden.Address
                Do
                    Set rUGIdFoundBorden = tblUGBorden.FindNext(rUGIdFoundBorden)
                    nRowCount = nRowCount + 1
                    If rUGIdFoundBorden Is Nothing Then Exit Do
                    If rUGIdFoundBorden.Address = sFirstAddress Then Exit Do
                Loop

                With wsBorden
                    Set tblUGItemBorden = .Range(.Cells(Split(sFirstAddress, "$")(2), "B"), .Cells(Split(sFirstAddress, "$")(2) + nRowCount - 1, "B"))
                End With

                For Each rUGItemVol In tblUGItemVol
                    On Error Resume Next
                    nMatch = 0
                    nMatch = WorksheetFunction.Match(rUGItemVol, tblUGItemBorden, 0) + 1
                    If nMatch > 0 Then
                        .Cells(rUGVol.Row, rUGItemVol.Column) = wsBorden.Cells(Split(sFirstAddress, "$")(2) + nMatch - 2, "C")
                    End If
                    On Error GoTo 0
                Next
            End If
        Next

    End With

End Sub

hth

gmk



Click the * below the post to say thanks and remember to mark the thread as solved if answered satisfactorily.

@planbms

As I said there would probably be a formula solution for this as well. This works in E2003, I don't use E2007 and there may be differences.
In your Volume.xls enter the formula into "C4" using CTRL + SHIFT and ENTER to get something like {=INDEX.......))}. If done correctly you will see the curly brackets. Then drag across to "AC3" and down to fill each of the required cells.

I have also improved the speed of the macro. So you now have 2 solutions. Try them and let me know.

Cell formula

=IF(ISNA(INDEX('[ADB.xls]Bordon Sales 2012'!$C$2:$C$274,MATCH($A4&C$3,'[ADB.xls]Bordon Sales 2012'!$A$2:$A$274&'[ADB.xls]Bordon Sales 2012'!$B$2:$B$274,0))),"",INDEX('[ADB.xls]Bordon Sales 2012'!$C$2:$C$274,MATCH($A4&C$3,'[ADB.xls]Bordon Sales 2012'!$A$2:$A$274&'[ADB.xls]Bordon Sales 2012'!$B$2:$B$274,0)))

Macro

Option Explicit

Sub GetCases2()

    Dim wsUGVol As Worksheet, wsBorden As Worksheet
    Dim iFirstRowVol As Integer
    Dim sFirstAddress As String
    Dim nRowCount As Long
    Dim rUGVol As Range, tblUGVol As Range, rUGItemVol As Range, tblUGItemVol As Range
    Dim rUGIdFoundBorden As Range, tblUGBorden As Range, tblUGItemBorden As Range
    Dim nMatch As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set wsBorden = Workbooks("ADB.xls").Sheets("Bordon Sales 2012")
    With wsBorden
        Set tblUGBorden = .Range(.Cells(1, "A"), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, "A"))   ''' col A Borden Sales
    End With

    Set wsUGVol = ThisWorkbook.Sheets("UG VOLUME REPORT APR 2012")
    With wsUGVol
        iFirstRowVol = 4
        Set tblUGVol = .Range(.Cells(iFirstRowVol, "A"), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, "A"))   ''' col A Volume
        Set tblUGItemVol = .Range(.Cells(3, "C"), .Cells(3, .Cells(3, .Columns.Count).End(xlToLeft).Column))    ''' row 3 Volume

        For Each rUGVol In tblUGVol
            nRowCount = 0
            Set rUGIdFoundBorden = tblUGBorden.Find(rUGVol, , xlValues, xlWhole, xlRows, xlNext, False) ''' find rows of each customer
            If Not rUGIdFoundBorden Is Nothing Then
                sFirstAddress = rUGIdFoundBorden.Address
                Do
                    Set rUGIdFoundBorden = tblUGBorden.FindNext(rUGIdFoundBorden)
                    nRowCount = nRowCount + 1
                    If rUGIdFoundBorden Is Nothing Then Exit Do
                    If rUGIdFoundBorden.Address = sFirstAddress Then Exit Do
                Loop

                With wsBorden   ''' set each range
                    Set tblUGItemBorden = .Range(.Cells(Split(sFirstAddress, "$")(2), "B"), .Cells(Split(sFirstAddress, "$")(2) + nRowCount - 1, "B"))
                End With

                For Each rUGItemVol In tblUGItemVol
                    On Error Resume Next
                    nMatch = 0
                    nMatch = WorksheetFunction.Match(rUGItemVol, tblUGItemBorden, 0) + 1
                    If nMatch > 0 Then
                        .Cells(rUGVol.Row, rUGItemVol.Column) = wsBorden.Cells(Split(sFirstAddress, "$")(2) + nMatch - 2, "C")  ''' get value
                    End If
                    On Error GoTo 0
                Next
            End If
        Next

    End With
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

hth

gmk



Click the * below the post to say thanks and remember to mark the thread as solved if answered satisfactorily.

WOW this is the 2nd most amazing thing I have ever seen! First is the birth of my son of course. THANKS VERY MUCH!

FYI...I am using the first code provided...

A couple questions for you...1, how does this work? And 2, if I change the file name of "ADB" to something else, will I have to change it in the macro as well since it looks as if it is looking for the file name? Does it look for the account number, then item number, and then dump the case sales there?

I have different markets (different account numbers) as well that have their own sales data. Everything is in the same format though. This is just one market. I tried to read the code and make sense of it, but if you could tell me what the macro is calling for, or referencing, I will know how to adjust it for the other accounts if need be. Once I see what it is doing, I can grasp it. Again, THANKS FOR YOUR TIME. This is great.

And how do I "like" your post?

@planbms

I'm pleased the code worked for you... but which?

I am using the first code provided...

Is that the first code in the first post or the first code in the second post?

If you can clarify whether you are using the formula or macro I will explain the formula or annotate the macro for you.

The formula looks complicated but isn't really - it's full of references to the ADB file which are a bit long winded. If you wish I'll give you a little tutor on how to construct it so you can employ similar for your other accounts. The macro is also easily adapted for other uses.

Let me know.

gmk

@planbms

You asked how does it work. If you meant the formula then…

The complete formula…

IF(ISNA(INDEX('[ADB.xls]Bordon Sales 2012'!$C$2:$C$350,MATCH($A4&C$3,'[ADB.xls]Bordon Sales 2012'!$A$2:$A$350&'[ADB.xls]Bordon Sales 2012'!$B$2:$B$350,0))),"",INDEX('[ADB.xls]Bordon Sales 2012'!$C$2:$C$350,MATCH($A4&C$3,'[ADB.xls]Bordon Sales 2012'!$A$2:$A$350&'[ADB.xls]Bordon Sales 2012'!$B$2:$B$350,0)))

But first, the core…

                                     target        what to match                              where to search                                  type of match
INDEX('[ADB.xls]Bordon Sales 2012'!$C$2:$C$350,MATCH($A4&C$3,'[ADB.xls]Bordon Sales 2012'!$A$2:$A$350&'[ADB.xls]Bordon Sales 2012'!$B$2:$B$350,0))

What the core formula in cell "C4" of the parent wb is saying is find Me an exact match of Customer id "$A4" and Product id "C$3" from columns "A" and "B" in the source wb.
If there is a match, get the position, INDEX (row, [column]) of the match and return the value of that row from the target array ("C").
Note, references to columns aren't necessary here as we only define one column "C" in the target array and column is therefore assumed to be "1".

To finish off...
Outside of the core is "IF(ISNA(…..)))". This is useful because MATCH will return "N/A" if a match isn't found and IF(ISNA simply says return a result if there is a match or leave Me blank.
Note the manner in which the 'what to match' cells are referenced i.e. absolute column for customer id ("$A4") and absolute row for product id ("C$3").
And not forgetting the "=" and curly brackets... there you have it.
So the formula when broken down is very simple but looks mega because it is padded out with lengthy wsheet references then doubled in length again by the IF N/A error function.

If you would like further assistance to either create this formula or adapt it for use in other accounts then don't hesitate, PM me. Just being cautious, never divulge sensitive data on the internet, even in a PM.

Thank you for the rep and comment, they are much appreciated. Please remember to use Thread Tools and mark the thread Solved if you have the required answer.

hth

gmk

Sorry...I am using the first macro. Please let me know how that works. Since I get a new report every month, do I need to change the file name to "ABD" so the macro can locate the correct report?

@planbms

As long as we come back to the thread at the end, I will PM you with a guide on how it works and how to adapt it for other accounts.

gmk

I actually figured it out today, and it's working perfect. Once again, I would like to thank you for all of your help.

I will mark this solved!

@planbms

Well done. I was just attending to some other thread and was going to start the task shortly. You have saved me some time. Thanks.

gmk