VBA Code running very slow to seperate 250 rows into 5 categories

The basics of this code are to examine a spreadsheet by multiple criteria and separate it into 5 categories. Then copy 4 of the categories and only certain column of data to another spreadsheet sorting it into 4 segregated areas on the spreadsheet, inserting rows as needed. It runs as it is but takes up to a minute to make it through the 250 rows and is inserting multiple blank rows and over righting other rows. What am I missing please

Private Sub ReportMakeReady_Click()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Unload Me
Dim FRow As Long
Dim LRow As Long
Dim ColAPLast1 As Long
Dim ColAPLast2 As Long
Dim APValues As Variant
Dim MRValues As Variant
Dim AP As Worksheet
Dim MR As Worksheet

Set AP = Worksheets("apartments")
Set MR = Worksheets("Make Ready")
    
Dim CRented As Long, CRemodel As Long, CAdmin As Long, CRNMI As Long, CStatus As Long, CUnit As Long
Dim CTurnNotes As Long, CUnitNotes As Long, CFinal As Long, CCabinets As Long, CFridge As Long, CRange As Long
Dim CAC As Long, CTub As Long, CCLean As Long, CPaint As Long, CVynal As Long, CUporDown As Long, CITV As Long
Dim CCarpet As Long, CMaint As Long, CMoveIn As Long, CFloorPlan As Long, CMoveOutRemodel As Long, CTurn As Long
    
Dim MRentedMain As Long, MRented1Bed As Long, MRented2Bed As Long
Dim MAvailMain As Long, MAvail1Bed As Long, MAvail2Bed As Long
Dim MNotAvailMain As Long, MNotAvail1Bed As Long, MNotAvail2Bed As Long
Dim MNoticeMain As Long, MNotice1Bed As Long, MNotice2Bed As Long, MEndLine As Long
    
Dim MUnit As Long, MFloorPlan As Long, MUporDown As Long, MRemodel As Long
Dim MMoveOutRemodel As Long, MMoveIn As Long, MStatus As Long, MMaint As Long
Dim MCarpet As Long, MVynal As Long, MPaint As Long, MClean As Long, MAC As Long, MFridge As Long
Dim MRange As Long, MTub As Long, MUnitNotes As Long, MTurnNotes As Long, MFinal As Long, MCabinets As Long

            With Worksheets("apartments")
                ColAPLast1 = .Cells(1, Columns.Count).End(xlToLeft).Column
                With .Range(.Cells(1, 1), .Cells(1, ColAPLast1))
                    CRented = .Find("Occupied").Column
                    CRNMI = .Find("RNMI").Column
                    CAdmin = .Find("Admin").Column
                    CTurn = .Find("Turned").Column
                    CITV = .Find("ITV").Column
                    CFloorPlan = .Find("Floor Plan").Column
                    CUnit = .Find("Apartment").Column
                    CUporDown = .Find("Up or Down").Column
                    CRemodel = .Find("Remodel").Column
                    CMoveOutRemodel = .Find("MO / Remodel").Column
                    CMoveIn = .Find("Move In").Column
                    CStatus = .Find("Status").Column
                    CMaint = .Find("Maintenance").Column
                    CCarpet = .Find("Carpet").Column
                    CVynal = .Find("Linoleum").Column
                    CPaint = .Find("Painted").Column
                    CCLean = .Find("Clean").Column
                    CAC = .Find("AC").Column
                    CFridge = .Find("Fridge").Column
                    CRange = .Find("Range").Column
                    CTub = .Find("Tub").Column
                    CCabinets = .Find("Cabinets").Column
                    CUnitNotes = .Find("Unit Notes").Column
                    CFinal = .Find("Final Inspec").Column
                    CTurnNotes = .Find("Turn Notes").Column
                End With
            End With
    
            With Worksheets("Make Ready")
                ColAPLast2 = .Cells(1, Columns.Count).End(xlToLeft).Column
                With .Range(.Cells(1, 1), .Cells(1, ColAPLast2))
                    MUnit = .Find("Unit").Column
                    MFloorPlan = .Find("Floor").Column
                    MUporDown = .Find("UpDown").Column
                    MRemodel = .Find("Remodel").Column
                    MMoveOutRemodel = .Find("Mo/Re Date").Column
                    MMoveIn = .Find("Move in").Column
                    MStatus = .Find("Status").Column
                    MMaint = .Find("Maint").Column
                    MCarpet = .Find("Carpet").Column
                    MVynal = .Find("Vynal").Column
                    MPaint = .Find("Paint").Column
                    MClean = .Find("Clean").Column
                    MAC = .Find("AC").Column
                    MFridge = .Find("Fridge").Column
                    MRange = .Find("Range").Column
                    MTub = .Find("Tub").Column
                    MCabinets = .Find("Cabinets").Column
                    MUnitNotes = .Find("Unit Notes").Column
                    MFinal = .Find("Final").Column
                    MTurnNotes = .Find("Turn Notes").Column
                End With
            End With
            
            With MR.Range("A1:A250")
                MRentedMain = .Find("RentedMain").Row
                MRented1Bed = .Find("Rented1Bed").Row
                MRented2Bed = .Find("Rented2Bed").Row
                MAvailMain = .Find("AvailableMain").Row
                MAvail1Bed = .Find("Available1Bed").Row
                MAvail2Bed = .Find("Available2Bed").Row
                MNotAvailMain = .Find("NotAvailableMain").Row
                MNotAvail1Bed = .Find("NotAvailable1Bed").Row
                MNotAvail2Bed = .Find("NotAvailable2Bed").Row
                MNoticeMain = .Find("NoticeMain").Row
                MNotice1Bed = .Find("Notice1Bed").Row
                MNotice2Bed = .Find("Notice2Bed").Row
                MEndLine = .Find("EndLine").Row
            End With
            
            With Worksheets("apartments")
                APValues = .Range(.Cells(1, 1), .Cells(250, ColAPLast1)).Value
            End With
            
            With Worksheets("Make Ready")
                MRValues = .Range(.Cells(1, 1), .Cells(250, ColAPLast2)).Value
            End With
            
    For FRow = 2 To 250
    
        If APValues(FRow, CAdmin) = "" And APValues(FRow, CRNMI) = "" And APValues(FRow, CITV) = "" _
            And APValues(FRow, CTurn) = "" And APValues(FRow, CRented) = "" Then
                If APValues(FRow, CFloorPlan) = "1x1 W/D" Or APValues(FRow, CFloorPlan) = "1x1" Then
                    LRow = ((MNotAvail2Bed - MNotAvail1Bed) - 2) + MNotAvail1Bed
                    MR.Cells(MNotAvail2Bed, 1).Offset(-1).EntireRow.Insert
                Else: APValues(FRow, CFloorPlan) = "2x1"
                    LRow = ((MNoticeMain - MNotAvail2Bed) - 2) + MNotAvail2Bed
                    MR.Cells(MNoticeMain, 1).Offset(-1).EntireRow.Insert
                End If
        ElseIf APValues(FRow, CAdmin) = "" And APValues(FRow, CRNMI) = "" And APValues(FRow, CITV) = "" _
            And APValues(FRow, CTurn) = "X" And APValues(FRow, CRented) = "" Then
                If APValues(FRow, CFloorPlan) = "1x1 W/D" Or APValues(FRow, CFloorPlan) = "1x1" Then
                    LRow = ((MAvail2Bed - MAvail1Bed) - 2) + MAvail1Bed
                    MR.Cells(MAvail2Bed, 1).Offset(-1).EntireRow.Insert
                Else: APValues(FRow, CFloorPlan) = "2x1"
                    LRow = ((MNotAvailMain - MAvail2Bed) - 2) + MAvail2Bed
                    MR.Cells(MNotAvailMain, 1).Offset(-1).EntireRow.Insert
                End If
        ElseIf APValues(FRow, CAdmin) = "" And APValues(FRow, CRNMI) = "" And APValues(FRow, CITV) = "X" _
            And APValues(FRow, CTurn) = "" And APValues(FRow, CRented) = "" Then
                If APValues(FRow, CFloorPlan) = "1x1 W/D" Or APValues(FRow, CFloorPlan) = "1x1" Then
                    LRow = ((MNotice2Bed - MNotice1Bed) - 2) + MNotice1Bed
                    MR.Cells(MNotice2Bed, 1).Offset(-1).EntireRow.Insert
                Else: APValues(FRow, CFloorPlan) = "2x1"
                    LRow = ((MEndLine - MNotice2Bed) - 2) + MNotice2Bed
                    MR.Cells(MEndLine, 1).Offset(-1).EntireRow.Insert
                End If
        ElseIf APValues(FRow, CAdmin) = "" And APValues(FRow, CRNMI) = "X" And APValues(FRow, CITV) = "" _
            And APValues(FRow, CTurn) = "" And APValues(FRow, CRented) = "" Then
                If APValues(FRow, CFloorPlan) = "1x1 W/D" Or APValues(FRow, CFloorPlan) = "1x1" Then
                    LRow = ((MRented2Bed - MRented1Bed) - 2) + MRented1Bed
                    MR.Cells(MRented2Bed, 1).Offset(-1).EntireRow.Insert
                Else: APValues(FRow, CFloorPlan) = "2x1"
                    LRow = ((MAvailMain - MRented2Bed) - 2) + MRented2Bed
                    MR.Cells(MAvailMain, 1).Offset(-1).EntireRow.Insert
                End If
        End If
            
            If LRow = 0 Then
            Else
                MR.Cells(LRow, MUnit).Value = AP.Cells(FRow, CUnit).Value
                MR.Cells(LRow, MFloorPlan).Value = AP.Cells(FRow, CFloorPlan).Value
                MR.Cells(LRow, MUporDown).Value = AP.Cells(FRow, CUporDown).Value
                MR.Cells(LRow, MRemodel).Value = AP.Cells(FRow, CRemodel).Value
                MR.Cells(LRow, MMoveOutRemodel).Value = AP.Cells(FRow, CMoveOutRemodel).Value
                MR.Cells(LRow, MMoveIn).Value = AP.Cells(FRow, CMoveIn).Value
                MR.Cells(LRow, MStatus).Value = AP.Cells(FRow, CStatus).Value
                MR.Cells(LRow, MMaint).Value = AP.Cells(FRow, CMaint).Value
                MR.Cells(LRow, MCarpet).Value = AP.Cells(FRow, CCarpet).Value
                MR.Cells(LRow, MVynal).Value = AP.Cells(FRow, CVynal).Value
                MR.Cells(LRow, MPaint).Value = AP.Cells(FRow, CPaint).Value
                MR.Cells(LRow, MClean).Value = AP.Cells(FRow, CCLean).Value
                MR.Cells(LRow, MAC).Value = AP.Cells(FRow, CAC).Value
                MR.Cells(LRow, MFridge).Value = AP.Cells(FRow, CFridge).Value
                MR.Cells(LRow, MRange).Value = AP.Cells(FRow, CRange).Value
                MR.Cells(LRow, MTub).Value = AP.Cells(FRow, CTub).Value
                MR.Cells(LRow, MCabinets).Value = AP.Cells(FRow, CCabinets).Value
                MR.Cells(LRow, MUnitNotes).Value = AP.Cells(FRow, CUnitNotes).Value
                MR.Cells(LRow, MFinal).Value = AP.Cells(FRow, CFinal).Value
                MR.Cells(LRow, MTurnNotes).Value = AP.Cells(FRow, CTurnNotes).Value
                LRow = 0
            End If
    
    Next FRow
    
    Worksheets("Make Ready").Activate
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True

End Sub

Hi,

Please edit your post and use code tags as required by our http://www.excelforum.com/forum-rule...rum-rules.html it really improves readability

Consider also posting sample workbook to play with.

Just at the first glance - there are many

somerange.Entirerow.Insert

commands - they can be quite time-consumming, especially if there is a lot of data below/above the range.

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

What should we do in this form before clicking the make ready button, to duplicate your issue?

You have a very busy workbook. You don't explain where to find the code in your first post. I found it because I did a search for the name of the procedure.

You have a lot of stuff in this workbook and to just say push a button and you will see a jumbled mess doesn't help me.
If we are talking about the layout form the only way I know to run it is by bringing it up in the VBE and choosing F5, then clicking the make ready button and then the form disappears, so whatever it is I'm supposed to see that's a garbled mess isn't apparent to me.

Okay so I open the workbook, I push the start button, the form opens I push make ready button the form closes and I'm not sure what I'm supposed to be seeing that's a garbled mess.

That's the kind of explanation I'm looking for. I'd be happy to take a look at it. I'm busy right now, so give me some time.

You have a seriously complicated worksheet here.
I'm trying to step through your F row loop code to see what's going on, but this function.

Private Function MouseProc

keeps getting triggered and then my Excel crashes. If you wrote this code and these API functions yourself I would think you are more than capable of stepping through this code and seeing what the values are and why it's doing what it's doing. If this function is triggering on every line that's probably a good clue as to why your code is so slow, as to what's going on with your other sheet I would suggest stepping through line by line and seeing what is happening.

MR.Cells(MNoticeMain, 1).Offset(-1).EntireRow.Insert" it offsets -2 once and -1 the next

It's adding one row each time and it adds the row offset -1 from the current value of MNoticeMain. You have eight lines that insert rows. I put a break point on each line just to make sure it was stopping and I ran through the loop line by line several times. MNoticeMain was always 25 each time it ran and it always inserted a row above. When you insert a row above, what happens is the row appears to be pushed down. I noticed that only one of the several times that I ran the code line by line did any data appear. The data was below the blue line labeled 2 bedroom and the data was 1614F 2X1 Up 9/14/2001 Not Ready, this data appeared on one of the first times I ran the code and then the code just kept adding rows and I didn't see any data being filled in.

Skywriter that was the kick in the teeth I needed. The row keys I am using (MNoticeMain is one of them) change location every time the loop runs and a row gets added. I had placed the keys outside the loop which was causing them to find their position once and the loop to keep over writing on itself. I moved them into the loop so that they get rechecked each time the loop runs and it works great now, Thank you.

You're welcome.

Please click the Thread Tools drop down box above your first post and choose solved.