How can I optimize my code

[viettest]

I'm going to try asking my question again as I can't come up with a faster solution for my code. Ill attach a sample of the excel sheet.

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

<colgroup><col><col><col><col></colgroup><tbody>
</tbody>

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.

 

[viettest]

I forgot to add a sample of the data and macro

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

<colgroup><col><col><col></colgroup><tbody>
</tbody>

Macro

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

 

[viettest]

Am I allowed to bump my thread?