How can I optimize my code

Period Backlog at the start of the month Volume Receive during the month Incident Completed during the month
Apr-17
May-17
Jun-17
Jul-17
Aug-17
Sep-17
Oct-17
Nov-17
Dec-17
Jan-18
Feb-18
Mar-18
Apr-18
May-18
Jun-18
Jul-18
Aug-18
Sep-18
Oct-18
Nov-18
Dec-18
Jan-19
Feb-19
Mar-19
Apr-19

This is the table I am trying to populate. I've already written the macro for it as you can see in Module 1. The problem I'm having is speed. The original data set has over 300,000 rows and this code takes over 30 seconds to run. This is just one section in one table and there are many tables to populate. I'm trying to see how others would approach tackling this type of problem. Please let me know if you require more information.

ID Date Logged Date Resolved
1 43123.40227 43123.46993
2 41904.53954 43010.32183
3 41941.54383 42873.2952
4 42055.62597 42922.37431
5 42067.59779 42922.33264
6 42072.46549 43217.52677
7 42072.47997 42993.49816
8 42095.56847 43202.58617
9 42103.46568 43067.52628
10 42124.57968 42865.46007
11 42129.62002 42922.55455
12 42131.41234 43046.37365
13 42139.46682 43201.48561
14 42187.50344 43223.59108
15 42262.42084 43243.4297
16 42276.33565 42936.65436
17 42276.4942 42922.37431
18 42285.55539 43432.64684
19 42296.6516 42922.33264
20 42299.50698 42837.47481

Sub TableData()


With Application
.Calculation = xlCalculationManual
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With


Dim wb As Workbook: Set wb = ActiveWorkbook
Dim wsData As Worksheet: Set wsData = wb.Sheets("Data")
Dim wsTable As Worksheet: Set wsTable = wb.Sheets("Table")


With wsData
DataArray = .Range("A1").CurrentRegion.Value2
DateLoggedCol = .Cells.Find("Date Logged").Address(ReferenceStyle:=xlR1C1): DateLoggedCol = Mid(DateLoggedCol, InStr(DateLoggedCol, "C") + 1, 3)
DateResolvedCol = .Cells.Find("Date Resolved").Address(ReferenceStyle:=xlR1C1): DateResolvedCol = Mid(DateResolvedCol, InStr(DateResolvedCol, "C") + 1, 3)
End With


With wsTable
Table1Array = .Range("A1").CurrentRegion.Value2
End With


For i = 2 To UBound(DataArray)
DateResBlank = IsEmpty(DataArray(i, DateResolvedCol))
For j = 3 To UBound(Table1Array)
Period = Table1Array(j, 1)
NextPeriod = DateAdd("m", 1, Period)
If DataArray(i, DateLoggedCol) < Period And (DataArray(i, DateResolvedCol) >= Period Or DataArray(i, DateResolvedCol) = "") Then
Table1Array(j, 2) = Table1Array(j, 2) + 1
End If
If DataArray(i, DateLoggedCol) > Period And DataArray(i, DateLoggedCol) < NextPeriod Then
Table1Array(j, 3) = Table1Array(j, 3) + 1
End If
If DataArray(i, DateResolvedCol) > Period And DataArray(i, DateResolvedCol) < NextPeriod Then
Table1Array(j, 4) = Table1Array(j, 4) + 1
End If
Next j
Next i


With wsTable
.Range("A1").CurrentRegion.Value2 = Table1Array
End With


With Application
.Calculation = xlCalculationManual
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
End With


End Sub