Macro running slow/freezing using autofill alternative for large dataset

[Rauce]

I'm trying to find real estate listings that match a certain criteria and output the desired listings that match those criteria. My code works start to finish but an intermediate step takes 20+ minutes if the listings are >3000 or more. My goal is to do it with 40,000 or more listings.

My bottleneck for speed is here:

Sub FillTable()

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

Worksheets("Pivot").PivotTables(1).ManualUpdate = True

Worksheets("Pivot").Select
Dim lrowcount as integer
Dim lcolcount as integer
lrowcount = ActiveSheet.PivotTables(1).TableRange2.Rows.Count
lcolcount = ActiveSheet.PivotTables(1).TableRange2.Columns.Count + 1



Sheets.Add After:=ActiveSheet

Dim x as integer

For x = 8 to lrowcount step 8

Range(Cells(x, 4), Cells (x, lcolcount)).FormulaR1C1 = "=IF(AND(Pivot!R[3]C" & LLC & "=Pivot!R[2]C, Pivot!R[5]C" & LLC & ">Pivot!R[4]C-R1C6, Pivot!R[5]C" & LLC & "<Pivot!R[4]C+R1C6, Pivot!R[7]C" & LLC & ">Pivot!R[6]C+R2C6, LEFT(Pivot!R[1]C3,6)=LEFT(Pivot!R7C,6)), 1, 0)"

Next


End Sub


I've tried loops, autofill, with, simple range placement and the speed seems to be about the same. I know that select and autofill can be slow and was able to eliminate them, but it's still slow. I also recognize that the nature of the formula requires a lot of work, just wondering if <10 minutes code run time is a reasonable expectation. This current code is the fastest I've been able to find but it still OFTEN just gets stuck in a 'not responding' cycle and tops 30 or more minutes to run. Any ideas on how to make this faster?




FULL EXPLANATION, IF NEEDED:
So how I've set it up, there are 2 large sets of listings, old listings and new listings on Sheet 1 and 2 respectively. These are then formatted into a pivot table on sheet 3. My issues starts in sheet 4. I've created a table with a complex formula pulling 8 different cells from data on sheet 3 and 4.

I want this code to place the formula in cell D8 and across horizontally to the end of the table, so there would be one line of data across most of the row (D8: D'lcolcount'). I then want it to skip 7 rows and place again across a row at D16:D'lcolcount' and so on until lrowcount (ideally thousands of rows below). If I run the code below about 100 times by hand it still takes a full 60 seconds. If i run the entire code, it often stops working.


I'd prefer not to include the entire sheet but can if needed.


[1]:

https://imgur.com/YUlp1

 

[Rauce]

Not sure why the facebook image is on there??
But here is a cleaner look to the code

Sub FillTable()

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

    Worksheets("Pivot").PivotTables(1).ManualUpdate = True

    Worksheets("Pivot").Select
        Dim lrowcount as integer
        Dim lcolcount as integer
        lrowcount = ActiveSheet.PivotTables(1).TableRange2.Rows.Count
        lcolcount = ActiveSheet.PivotTables(1).TableRange2.Columns.Count + 1



    Sheets.Add After:=ActiveSheet

    Dim x as integer

    For x = 8 to lrowcount step 8

        Range(Cells(x, 4), Cells (x, lcolcount)).FormulaR1C1 = "=IF(AND(Pivot!R[3]C" & LLC & "=Pivot!R[2]C, Pivot!R[5]C" & LLC & ">Pivot!R[4]C-R1C6, Pivot!R[5]C" & LLC & "<Pivot!R[4]C+R1C6, Pivot!R[7]C" & LLC & ">Pivot!R[6]C+R2C6, LEFT(Pivot!R[1]C3,6)=LEFT(Pivot!R7C,6)), 1, 0)"

    Next


End Sub