Add incremental information from a sheet to another

[milt2004]

I have a DATABASE SHEET which should take information from different sheets (“order sheet”) that I create from a template.
I want every time that I create a new “order sheet” the database sheet (the first column only, named “Quantity”) to be informed automatically.

How can I do this?

To understand better my problem I’ve made an example with two different “order sheets” and the respective database.


first order:

Book1
	A	B	C	D	E
1	(first)OrderSheet
2	Quantity	Type	Name	Metals
3	1	ring	walk	gold	silver
4	2	bracelet	star		silver
5	1	ring	merlin	gold
6	1	ring	camaleon	gold
7	2	bracelet	snake		silver
8	1	ring	bird	gold
Sheet1

first database:

Book1
	A	B	C	D	E
1	(first)DatabaseSheet
2	Quantity	Type	Name	Metals
3	1	ring	walk	gold	silver
4	2	bracelet	star		silver
5	1	ring	merlin	gold
6	1	ring	camaleon	gold
7	2	bracelet	snake		silver
8	1	ring	bird	gold
Sheet2

second order:

Book1
	A	B	C	D	E
1	(second)OrderSheet
2	Quantity	Type	Name	Metals
3	1	ring	walk	gold	silver
4	1	bracelet	star		silver
5	3	ring	merlin	gold
6	2	ring	camaleon	gold
7	1	bracelet	snake		silver
8	2	ring	bird	gold
Sheet3

Now, the "Quantity" information in the second order have to added (incrementally) in the “Database Sheet”:

updated database:

Book1
	A	B	C	D	E
1	DatabaseSheet
2	Quantity	Type	Name	Metals
3	2	ring	walk	gold	silver
4	3	bracelet	star		silver
5	4	ring	merlin	gold
6	3	ring	camaleon	gold
7	3	bracelet	snake		silver
8	3	ring	bird	gold
Sheet4

Thanks.

EDIT: Removed IMG Tags, they're unnecessary with the HTML Maker code - Moderator

 

[milt2004]

milt2004

assuming:
1) the sheet layout is exactly the same as you have posted
2) both books are open

Sub test()
Dim dic As Object, a, i As Long, wsDB As Worksheet, wsOrd As Worksheet
Dim ii As Long, w()
Set dic = CreateObject("Scripting.Dictionary")
Set wsDB = ThisWorkbook.Sheets("Sheet1")
Set wsOrd = Workbooks("OrderWorkbookNameHere").Sheets("Sheet1")
With wsDB.Range("a1").CurrentRegion
   If .Rows.Count > 2 Then
      a = .Resize(.Rows.Count-2,.Columns.Count).Offset(2).Value
      For i = 1 To UBound(a,1)
         If Not IsEmpty(a(i,1)) And Not dic.exists(a(i,1)) Then
            ReDim w(1 To UBound(a,2))
            For ii = 1 To UBound(a,2) : w(ii) = a(i,ii) : Next
            dic.add a(i,1), w
         End If
      Next
   Else
      wsOrd.Rows("1:2").Copy .Rows("1:2")
   End If
   With wsOrd.Range("a1").CurrentRegion
      a = .Resize(.Rows.Count-2,.Columns.Count).Offset(2).Value
      For i = 1 To UBound(a,1)
         If Not IsEmpty(a(i,1)) Then
            If Not dic.exists(a(i,1)) Then
               ReDim w(1 To UBound(a,2))
               For ii = 1 To UBound(a,2) : w(ii) = a(i,ii) : Next
               dic.add a(i,1), w
            Else
               w = dic(a(i,1))
               w(2) = w(2) + a(i,2)
               dic(a(i,1)) = w
            End If
         End If
      Next
   End With
   y = dic.items : Set dic = Nothing : Erase a
   With .Range("a" & Rows.Count).End(xlUp).Offset(1)
      For i = 0 To UBound(y)
         .Offset(i).Resize(,UBound(y)).Value = y(i)
      Next
   End With
End With
Set wsDB = Nothing : Set wsOrd = Nothing
End Sub

If I understund rigth, I have to put the code in the Order Sheet. Is it right?

 

[milt2004]

Hi jindon.
I try your code but maybe I need more details about how to apply it.

Please help.

 

[jindon]

milt2004
1) while you are on Master file, hit Alt + F11, [Insert]-[Module} then paste the code and change the book name of "book2.xls" to the book name that you have data in.
2) hit Alt + F11 again to get back to Excel
3) go to [Tools]-[Macro]-[Macro] choose "test" and hit "run"

Sub test()
Dim dic As Object, a, i As Long, wsDB As Worksheet, wsOrd As Worksheet
Dim ii As Long, w()
Set dic = CreateObject("Scripting.Dictionary")
Set wsDB = ThisWorkbook.Sheets("Sheet1")
Set wsOrd = Workbooks("book2.xls").Sheets("Sheet1")
With wsDB.Range("a1").CurrentRegion
   If .Rows.Count > 2 Then
      a = .Resize(.Rows.Count - 2, .Columns.Count).Offset(2).Value
      For i = 1 To UBound(a, 1)
         If Not IsEmpty(a(i, 1)) And Not dic.exists(a(i, 1)) Then
            ReDim w(1 To UBound(a, 2))
            For ii = 1 To UBound(a, 2): w(ii) = a(i, ii): Next
            dic.Add a(i, 1), w
         End If
      Next
   Else
      wsOrd.Rows("1:2").Copy .Rows("1:2")
   End If
   With wsOrd.Range("a1").CurrentRegion
      a = .Resize(.Rows.Count - 2, .Columns.Count).Offset(2).Value
      For i = 1 To UBound(a, 1)
         If Not IsEmpty(a(i, 1)) Then
            If Not dic.exists(a(i, 1)) Then
               ReDim w(1 To UBound(a, 2))
               For ii = 1 To UBound(a, 2): w(ii) = a(i, ii): Next
               dic.Add a(i, 1), w
            Else
               w = dic(a(i, 1))
               w(2) = w(2) + a(i, 2)
               dic(a(i, 1)) = w
            End If
         End If
      Next
   End With
   y = dic.items: Set dic = Nothing: Erase a
   With .Range("a3")
      For i = 0 To UBound(y)
         .Offset(i).Resize(, UBound(y(i))).Value = y(i)
      Next
   End With
End With
Set wsDB = Nothing: Set wsOrd = Nothing
End Sub