Macro Freezes PC

[Dazzawm]

A friend has very kindly given me a Macro that does what I need it to do. The problem is after it has been running a few minutes Excel stops responding and freezes and I have to ctrl+alt+del. The macro is a very small code but has to look through a lot of data. What can be done to speed macros up?

 

[MrKowz]

Just poking my head in here. Are you sure it is freezing? It is looping a LOT, and if you have a lot of data, it could take a while.

Try using this, watch the statusbar and confirm that A and aa are increasing:

Sub MatchAndUpdate()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With
r = Sheets("Source").Range("A" & Rows.Count).End(xlUp).row
For A = 1 To r
    q = Sheets("Source").Cells(A, 12).Text
    RR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).row
    For aa = 1 To RR
        [B][COLOR=red]Application.StatusBar = "Currently on A = " & A & " and aa = " & aa
[/COLOR][/B]        If Not IsError(Sheets("Sheet1").Cells(aa, 12)) Then
            If Sheets("Sheet1").Cells(aa, 12).Text = q Then
                x = Sheets("Sheet1").Cells(aa, 9).Text
                xx = Sheets("Source").Cells(A, 9).Text
            If x = xx Then GoTo nextaa
            If Mid$(xx, 1, Len(x)) = x Then
                Sheets("Sheet1").Cells(aa, 9) = Sheets("Source").Cells(A, 9)
                Sheets("Sheet1").Cells(aa, 9).Interior.ColorIndex = 6
            End If
            End If
        End If
nextaa:
    Next aa
Next A
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
[B][COLOR=red]    .StatusBar = False[/COLOR][/B]
End With
End Sub

 

[Dazzawm]

Same error on that line. i think maybe it lies within colouring in the cell. It worked ok (all be it slowly before) but I asked if the cell could be coloured in so I could check the changes that have been made.

 

[Dazzawm]

Thanks MrKowz I tried that and they were counting up A was counting up slowly and aa fast to about 6000 which I suppose is the rows I have. It got up to A 14 or so which I suppose was row 14? If it was it should have made changes in rows 6, 7 and 9 that I could see but it didn't. I then inadvertently clicked on the file somewhere and it stopped counting and froze.

 

[MrKowz]

Check and see how this macro runs for you. I think I followed the logic correctly from the post you linked earlier.

Public Sub Dazwm()
Dim s   As Long, _
    d   As Long, _
    sLR As Long, _
    dLR As Long, _
    sWS As Worksheet, _
    dWS As Worksheet
    
Set sWS = Sheets("Source")
Set dWS = Sheets("Sheet1")
    
sLR = sWS.Range("A" & Rows.Count).End(xlUp).row
dLR = dWS.Range("A" & Rows.Count).End(xlUp).row
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With
For s = 1 To sLR
    For d = 1 To dLR
        Application.StatusBar = "Currently checking source row " & s & " versus destination row " & d & "."
        If sWS.Cells(s, 12).Value = dWS.Cells(d, 12).Value Then
            If Left(sWS.Cells(s, 9).Value, InStr(sWS.Cells(s, 9).Value & "-", "-")) = dWS.Cells(d, 9).Value Then
                dWS.Cells(d, 9).Value = sWS.Cells(s, 9).Value
                dWS.Cells(d, 9).Interior.ColorIndex = 6
            End If
        End If
    Next d
Next s
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .StatusBar = False
End With
End Sub

 

[Dazzawm]

That doesn't work either. Its not making any changes to the early rows I can see on the spreadsheet. Am I asking it to do too much?

 

[MrKowz]

Given the sample data in your other post, the code I provided is working fine on my end. Are you able to provide actual data so we might be able to dig deeper?

 

[Dazzawm]

I have sent you a PM MrKowz.