Program not responding -excel vba for loop - vba

Question

I am trying to get sum by month value each time if the two strings on two sheets match
Now I don't see anywhere it is going in an infinite loop but still this program is not responding after a while and I have to eventually close excel via; task manager because even Break command wasn't working.
This is a fairly simply program but I don't know how can I make it shorter than this Please advise.
Option Explicit
Sub SumByMon()
Application.ScreenUpdating = False
Dim wk As Worksheet, wt As Worksheet
Dim Astr As String, Bstr As String
Dim i, j, FinalRow, FinalRowG As Long
Dim sm As Double, Jsum As Double, Fsum As Double, Msum As Double, Asum As Double, Masum As Double, Jusum As Double, Julsum As Double, Ausum As Double, Ssum As Double, Osum As Double, Nsum As Double, Dsum As Double
Dim Dt
Dim LMon As Integer
Set wk = Sheets("BR Mailing List_12-4-15 (3)")
Set wt = Sheets("Total By Month")
FinalRowG = wk.Range("N900000").End(xlUp).Row
FinalRow = wt.Range("A900000").End(xlUp).Row
For i = 2 To FinalRow
Jsum = 0
Fsum = 0
Msum = 0
Asum = 0
Masum = 0
Jusum = 0
Julsum = 0
Ausum = 0
Ssum = 0
Osum = 0
Nsum = 0
Dsum = 0
Astr = Trim(wt.Range("A" & i))
For j = 2 To FinalRowG
Bstr = Trim(wk.Range("N" & j))
If Astr = Bstr Then
Dt = wk.Range("T" & j).Value
LMon = Month(Dt)
Select Case LMon
Case 1
sm = wk.Range("S" & j).Value
Jsum = Jsum + sm
Case 2
sm = wk.Range("S" & j).Value
Fsum = Fsum + sm
Case 3
sm = wk.Range("S" & j).Value
Msum = Msum + sm
Case 4
sm = wk.Range("S" & j).Value
Asum = Asum + sm
Case 5
sm = wk.Range("S" & j).Value
Masum = Masum + sm
Case 6
sm = wk.Range("S" & j).Value
Jusum = Jusum + sm
Case 7
sm = wk.Range("S" & j).Value
Julsum = Julsum + sm
Case 8
sm = wk.Range("S" & j).Value
Ausum = Ausum + sm
Case 9
sm = wk.Range("S" & j).Value
Ssum = Ssum + sm
Case 10
sm = wk.Range("S" & j).Value
Osum = Osum + sm
Case 11
sm = wk.Range("S" & j).Value
Nsum = Nsum + sm
Case 12
sm = wk.Range("S" & j).Value
Dsum = Dsum + sm
Case Else
Debug.Print LMon
End Select
Else: End If
Next j
wt.Range("B" & i) = Jsum
wt.Range("C" & i) = Fsum
wt.Range("D" & i) = Msum
wt.Range("E" & i) = Asum
wt.Range("F" & i) = Masum
wt.Range("G" & i) = Jusum
wt.Range("H" & i) = Julsum
wt.Range("I" & i) = Ausum
wt.Range("J" & i) = Ssum
wt.Range("K" & i) = Osum
wt.Range("L" & i) = Nsum
wt.Range("M" & i) = Dsum
Next i
wt.Select
Range("A1").Select
Application.ScreenUpdating = True
End Sub
Thanks for all your effort but even by using array method it is getting in Non-Responding state if you want to have a look at the File Here it is.

Answer 1

There are a number of reasons why this code could have problems:
This line could fail if it's an old or compatibility mode version of Excel : wk.Range("N900000").End(xlUp).Row.
You are writing every cell individually which is very time-consuming. If Sheet3 has a lot of rows in it then your code could appear locked because it's taking so long to write
Your declarations have ceded control of types because all the 'untyped' declarations are Variants. This makes debugging very difficult. In your comment you ask "is it necessary?". Answer: not critical, but it will increase your debugging task by an order of magnitude and the code might work in ways you don't expect. In truth, a practical answer is "yes, it's very necessary".
There are no checks of the cell values and types. If cells are empty or not dates, your code will still run, And if all your variables are Variants, your code will aggregate incorrectly when you run Month(dt).
Using the .Text property can cause problems. If for example the date column is too narrow and you have #### in the cell, then that will be the .Text value (again, out of your control if your variable is an 'undeclared' Variant. Better would be Cstr(cell.Value) or Cstr(cell.Value2).
Your code is very inefficient because it loops through the same data in Sheet1 over and over again. Far better would be to load that just once into a collection whose key is the string value that you are testing. I haven't done that in the sample below as I'm a bit short of time but you should look into doing it. If Sheet1 has a lot of rows then your code really will be slow.
The other point is that it's far quicker to write an array to the Worksheet rather than one cell at a time. In your case, the month aggregations are ideally suited to an array. So you could optimise and shorten your code by using one. The code below deals with the points above and uses an array as an example for you.
You also seem a little unclear about the Debug.Print suggestion made by Noam Hacker. It's a good suggestion so I've given you a couple of examples of it in this code:
Public Sub SumByMonWithArray()
Dim startRowA As Long, startRowB As Long
Dim finalRowA As Long, finalRowB As Long
Dim strA As String, strB As String
Dim m() As Variant
Dim dt As Variant
Dim r As Long, c As Long
Dim i As Long, j As Long
'Define the start and end rows of each sheet
startRowA = 2
startRowB = 2
finalRowA = Sheet3.Cells(Sheet3.Rows.Count, "A").End(xlUp).Row
finalRowB = Sheet1.Cells(Sheet1.Rows.Count, "N").End(xlUp).Row
'Dimension your array
r = finalRowA - startRowA + 1
If r < 1 Then Exit Sub 'exit if there's no data
ReDim m(1 To r, 1 To 12)
For i = startRowA To finalRowA
Debug.Print "In loop i=" & CStr(i) 'shows progress (delete after testing)
strA = Trim(CStr(Sheet3.Cells(i, "A").Value2))
'If test value isn't blank run the comparison
If strA <> "" Then
r = i - startRowA + 1
For j = startRowB To finalRowB
Debug.Print "In subloop i=" & CStr(i) & ", j=" & CStr(j) 'shows progress (delete after testing)
strB = Trim(CStr(Sheet1.Cells(j, "N").Value2))
'If there's a match aggregate the month array
If strB <> "" And strA = strB Then
'Populate a Variant with cell value and check it's a date
dt = Sheet1.Cells(j, "T").Value
If IsDate(dt) Then
c = Month(dt) 'Gets the column index of the array
m(r, c) = m(r, c) + CDbl(Sheet1.Cells(j, "S").Value2)
End If
End If
Next
End If
Next
'Write the aggregate array to Sheet 3
With Sheet3
.Cells(startRowA, "B").Resize(UBound(m, 1), UBound(m, 2)).Value = m
.Activate
.Range("A1").Select
End With
Application.ScreenUpdating = True
End Sub

Answer 2

Consider this mock-up data in Sheet1:
First add a column to the right of column T (Date of Sales?) with formula =MONTH(T2) for cell U2.
Add/Change the Monthly label to Integer (B1:M1 in sample).
Then create dynamic named ranges:
SalesItemCol with formula =OFFSET(Sheet1!$N$1,1,0,COUNTA(Sheet1!$N:$N)-1,1)
SalesQtyCol with formula =OFFSET(Sheet1!$N$1,1,5,COUNTA(Sheet1!$N:$N)-1,1)
SalesMonthCol with formula =OFFSET(Sheet1!$N$1,1,7,COUNTA(Sheet1!$N:$N)-1,1)
Finally on B2, use formula =SUMIFS(SalesQtyCol,SalesItemCol,$A2,SalesMonthCol,B$1) then auto fill the rest.
Alternatively you can create macro to do the above...