VBA Check if Cell is Empty & Add to Database Sheet

[unknownymous]

Hi Excel Gurus,

I'm working on an macro project and almost done. I'm just having a problem on this: I have 2 excel sheet, one is working file and the other is database. What the macro needs to do is to check the cell with blank category (in working file) and add below column data in the database (next blank cell).

1) Merged Name
2) Addr
3) Code


*Working File Excel Sheet (Working tab)

Ref	Merged Name	Name 1	Name 2	Addr	Code	Quantity	Category
001	Sean Smith	Sean	Smith	LA	111	5000	Included
002	Ian Grop	Ian	Grop	SA	125	4500	Excluded
003	Lea Mason	Lea	Mason	AM	116	4000	For Review
004	Tricia Javier	Tricia	Javier	MT	102	3000
005	Den Berthe	Den	Berthe	BE	115	2500	Excluded
006	Mae Lim	Mae	Lim	AB	136	2000
007	Oscar Charde	Oscar	Charde	CH	140	1000

<tbody>
</tbody>

*Database Excel Sheet (Database tab)

Account	Data 1	Merged Name	Data 2	Addr	x	Code	xx	xxx	Category
		Sean Smith		LA		111			Included
		Ian Grop		SA		125			Excluded
		Lea Mason		AM		116			For Review
		Den Berthe		BE		115			Excluded

<tbody>
</tbody>

Any help will be much appreciated.

 

[Fluff]

How about

Sub unknownymous()
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   Dim Cl As Range
   
   Set Ws1 = Sheets("sheet1")
   Set Ws2 = Sheets("sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws1.Range("C2", Ws1.Range("C" & Rows.Count).End(xlUp))
         v = Join(Application.Index(Cl.Resize(, 5).Value, 1, Array(1, 3, 5)), "|")
         .Item(v) = Cl.Offset(, 7).Value
      Next Cl
      For Each Cl In Ws2.Range("B2", Ws2.Range("B" & Rows.Count).End(xlUp))
         v = Join(Application.Index(Cl.Resize(, 5).Value, 1, Array(1, 4, 5)), "|")
         Cl.Offset(, 6).Value = .Item(v)
      Next Cl
   End With
End Sub

 

[unknownymous]

This is amazing Fluff.

One thing, what if I want to add the Quantity from Working File and put it in the column next to Code in Database File?

 

[Fluff]

How about

Sub unknownymous()
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   Dim Cl As Range
   Dim v As String
   
   Set Ws1 = Sheets("sheet1")
   Set Ws2 = Sheets("sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws2.Range("B2", Ws2.Range("B" & Rows.Count).End(xlUp))
         v = Join(Application.Index(Cl.Resize(, 5).Value, 1, Array(1, 4, 5)), "|")
         .Item(v) = .Item(v) + Cl.Offset(, 5).Value
      Next Cl
      For Each Cl In Ws1.Range("C2", Ws1.Range("C" & Rows.Count).End(xlUp))
         v = Join(Application.Index(Cl.Resize(, 5).Value, 1, Array(1, 3, 5)), "|")
         Cl.Offset(, 5).Value = .Item(v)
      Next Cl
   End With
End Sub

 

[unknownymous]

This is great! Thanks a lot Fluff!

 

[Fluff]

You're welcome & thanks for the feedback