Create a new version of paste:

New Paste

Syntax Highlighting

Option Explicit ' http://www.eileenslounge.com/viewtopic.php?f=30&t=31294&p=242212#p242212
'    We have two worksheets, a DATA  worksheet and a results worksheet.
'    We have two similar data ranges in columns B:D:
'    _ one data range in data worksheet
'    and
'    _ the other data range  in results worksheet.
'    In column C in both worksheets are values.
'    Columns B and D are some identifying Item number and supplier.
'
'     It appears that periodically the results worksheet will be updated  by adding the values in the data worksheet ( column C) to the values already  in the results worksheet ( column C). Possibly the supplier is also updated, this is unclear**
'     Column B appears to be a  unique identifying  Item numbers. Possibly the supplier ( column D )  may change, that is not clear**.
'    In the periodic updating, the results data will have the values ( column C)  from data worksheet added to its value ( column C ) , depending on the corresponding identifying  Item number being present in both the results worksheet and the DATA dictionary: This Existence is determined by checking for the Existence of the Key within the ###dictionary  with the Key name of the Item Number  from each row in column B in results worksheet
'     The results worksheet will also have the supplier indicated in data worksheet for that item number updated. ( In the supplied test data the supplier never changes for a particular Item number, so this makes the situation unclear**  )
'
'    In the current codes a ###dictionary is used. This is built using the data from the data worksheet. No check is made for existing Keys, so this suggests that Item numbers won't be repeated in the data worksheet. If they are repeated  then that furthest down will be taken and the previous ignored/ overwritten.
'    I personally would not have used a dictionary approach for this. The dictionary approach might make the final code a bit more efficient, but it does make things a lot more confusing
'    I am also wondering if the code is doing the things the wrong way around: it might have been   better to make the dictionary using the results Item numbers as keys. That way if item numbers were repeated in the data, then all new data values would be added…
'     **Once again, the supplied test data should have been better chosen, in my opinion, to better show all possible scenarios.

Sub AddValuesInTheSameCell()
Rem 1 input and output existing data
'1a) Input DATA range without header
Dim vItems() As Variant: let vItems() = Sheet1.Range("B2", Sheet1.Cells(Rows.Count, "B").End(xlUp)).Resize(, 3).Value
'1b) results sheet, column B items ( no header )
Dim vData() As Variant: Let vData() = Sheet2.Range("B2", Sheet2.Cells(Rows.Count, "B").End(xlUp)).Value
'1c) results sheet, column c-d ( no header )
Dim vOut() As Variant: Let vOut() = Sheet2.Range("B2", Sheet2.Cells(Rows.Count, "B").End(xlUp)).Offset(, 1).Resize(, 2).Value
Rem 2 A dictionary will be made from the new DATA, then the results will be added to using that DATA
    With Sheet2.Range("B2", Sheet2.Cells(Rows.Count, "B").End(xlUp))
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
        Dim i As Long
        '2a Build DATA Dictionary  Key:= as Item 1, Item 2 etc,  Item:= as C value & "|" & suppliers
            For i = LBound(vItems()) To UBound(vItems())
                .Item(vItems(i, 1)) = vItems(i, 2) & "|" & vItems(i, 3) 'like for row 2 data  item(Item 1) = "|Resource Name 1"  for first with empty C2   for second   "1000|Resource Name 2"    - so it is a concatenation of the value in C and the suppliers in D
            Next i
        '2c Now go down results data, and if we have an Item number that is in the new DATA dictionary, then we may want to add the value if there is one, (and also we update the suppier**)
            For i = LBound(vData()) To UBound(vData()) ' vData() is Item Number column B of results worksheet
                If .Exists(vData(i, 1)) Then ' look for the Key of  Item 1, Item 2  etc in current results,
                    If Split(.Item(vData(i, 1)), "|")(0) = "" Or Split(.Item(vData(i, 1)), "|")(0) = 0 Then
                    'Do Nothing
                    Else ' case of data value in data sheet c column
                     vOut(i, 1) = Split(.Item(vData(i, 1)), "|")(0) + vOut(i, 1) ' The new data number  is added to the current number already in results column C
                     vOut(i, 2) = Split(.Item(vData(i, 1)), "|")(1) ' update the supplier**
                    End If
                Else ' The Item number in column B of results is not in the new DATA dictionary Key names list
                End If
            Next i ' effectively go to next row in results worksheet
        End With
        .Offset(, 1).Resize(, 2).Value = vOut()
    End With
End Sub

Optional Paste Settings

Category:

Tags:

Syntax Highlighting:

Paste Expiration:

Paste Exposure:

Folder:

PasswordNEW

Disabled

Burn after read NEW

Paste Name / Title:

Hello Guest

You are currently not logged in, this means you can not edit or delete anything you paste. Sign Up or Login