VBA code to find lookup value from two data sets.

data appears to be large. about 1600 rows.

to check each ngm and also each month (there are nine months
so the intersectiosn are 1600x9=14400 cells have to be checked.
of course macro has been writen

there re two macro test and testone
testone is embedded in test
SO YOU NEED TO RUN ONLY "TEST"

attached file " excevba123 VB Challenge.xlsm" is AFTER running the macro
to retest run "test" agains. becaue of 11400 cells it takes between one minute and one and half minutes

the macros are in the module of the file and also repeated here

Dim ngm As Range, mmonth As Range, unq As Range, cunq As Range, filt As Range
Dim rdata As Range, unqmonth As Range, cmonth As Range, ssum As Double
Sub test()
Application.ScreenUpdating = False
 Worksheets("sheet2").Activate
 

Range(Range("a1").End(xlDown).Offset(5, 0), Cells(Rows.Count, "A")).EntireRow.Delete
testone
Set ngm = Range(Range("A1"), Range("a1").End(xlDown))
Set unq = ngm(1, 1).End(xlDown).Offset(5, 0)
'MsgBox unq.Address

ngm.AdvancedFilter xlFilterCopy, , unq, True
Range("D1") = "month of date"
Set mmonth = Range(Range("D1"), Range("D1").End(xlDown))

mmonth.AdvancedFilter xlFilterCopy, , unq.Offset(0, 1), True

Set rdata = Range("a1").CurrentRegion
Set unqmonth = Range(unq.Offset(1, 1), unq.Offset(1, 1).End(xlDown))

unqmonth.Select
Selection.Copy
unq.Offset(0, 1).Select
 Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Range(unq.Offset(1, 1), unq.Offset(1, 1).End(xlDown)).Cells.Clear
Set unqmonth = Range(unq.Offset(0, 1), unq.End(xlToRight))
Set unq = Range(unq.Offset(1, 0), unq.End(xlDown))

For Each cunq In unq
For Each cmonth In unqmonth
rdata.AutoFilter field:=1, Criteria1:=cunq
rdata.AutoFilter field:=4, Criteria1:=cmonth.Value
Set filt = rdata.SpecialCells(12)
ssum = WorksheetFunction.Sum(rdata.Columns("c:c").Cells.SpecialCells(12))
If ssum = 0 Then GoTo nextcmonth
Application.Intersect(Rows(cunq.Row), Columns(cmonth.Column)) = ssum
Application.Intersect(Rows(cunq.Row), Columns(cmonth.Column)).NumberFormat = "[$£-809]#,##0.00"
ActiveSheet.AutoFilterMode = False
nextcmonth:

Next cmonth
Next cunq
Range("d1").EntireColumn.Delete
'.Range("a1").End(xlDown).Offset(5, 0).CurrentRegion.Cells.NumberFormat = "[$£-809]#,##0.00"
'End With
Application.ScreenUpdating = True
MsgBox "macro over"
End Sub

Sub testone()
Dim j As Integer, r As Range
With Worksheets("sheet2")
j = .Range("a1").End(xlDown).Row
Set mmonth = Range(.Range("B1"), .Range("B1").End(xlDown))
Set r = mmonth.Offset(1, 0).Resize(mmonth.Rows.Count - 1)
'MsgBox r.Address
'MsgBox r.Offset(0, 2).Address
r.Offset(0, 2).Formula = "=month(" & r.Address & ")"

End With

End Sub