xladept,

I have found the solution from my first question by modify your code a litte:
Dim wr As Worksheet, wb As Worksheet, ws As Worksheet, wl As Worksheet
Dim r1 As Long, r2 As Long, s As Long, b As Long, i As Long, l As Long, c As Long, MG, RA, MG2

Set wr = Worksheets("rawdata")
Set wb = Worksheets("base")
Set ws = Worksheets("summary")
Set wl = Worksheets("backlog")
Set MG = CreateObject("Scripting.Dictionary")
Set MG2 = CreateObject("Scripting.Dictionary")

b = 2
Do Until wb.Cells(b, 1) = ""
MG.Item(Trim(wb.Cells(b, 1))) = wb.Cells(b, 2)
b = b + 1
Loop

c = 19
Do Until wr.Cells(2, c + 1) = ""
c = c + 1
Loop

d = 2
Do Until wr.Cells(d, 19) = ""
MG2.Item(Trim(wr.Cells(d, 19))) = wr.Cells(d, 24)
d = d + 1
Loop

r = WorksheetFunction.Max(lra, lrb)
RA = wr.Range(wr.Cells(1, 1), wr.Cells(r, c))
For i = 3 To lra
    'iw3m
    RA(i, 15) = MonthName(Month(RA(i, 4)))
    RA(i, 16) = Year(RA(i, 4))
    
    If MG2.Exists(Trim(RA(i, 5))) Then
        RA(i, 17) = MG.Item(Trim(MG2.Item(Trim(RA(i, 5)))))
    Else
        RA(i, 17) = "Non ZSPA"
    End If
    
    'mm60
    If Not RA(i, c - 2) = "" Then
        RA(i, c) = Year(RA(i, c - 2))
    Else
        RA(i, c) = ""
    End If
    
    If MG.Exists(Trim(RA(i, 24))) Then
        RA(i, c - 1) = MG.Item(Trim(RA(i, 24)))
    Else
        RA(i, c - 1) = ""
    End If
Next i
  
wr.Range(wr.Cells(1, 1), wr.Cells(r, c)) = RA
Note:
lra and lrb are the same as your r1 & r2 respectively

It took me around 6 second to complete the process, if a faster solution existed please assist me.

As for the second question I am still trying to figure it out..