Excel Crashing

Blobajob88

Board Regular
Joined
Mar 27, 2020
Messages
55
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi,

I've produced code in the activate and change events on a spreadsheet I am working on and it keeps crashing my computer. Could someone please have a look at my code and figure out why. It technically works but is too demanding of my laptop

VBA Code:
Private Sub Worksheet_Activate()

ThisWorkbook.Worksheets("Procurement Schedule").Protect userinterfaceonly:=True

Range("p3").Value = DateDiff("d", Date, Range("o3").Value) & " Days Until Skid Completion"
If DateDiff("d", Date, Range("o3").Value) >= 21 Then
Range("p3").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o3").Value) >= 10 And DateDiff("d", Date, Range("o3").Value) < 21 Then
Range("p3").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o3").Value) < 10 Then
Range("p3").Font.Color = rgbRed
End If

Range("p4").Value = DateDiff("d", Date, Range("o4").Value) & " Days Until Kiosk Completion"
If DateDiff("d", Date, Range("o4").Value) >= 21 Then
Range("p4").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o4").Value) >= 10 And DateDiff("d", Date, Range("o4").Value) < 21 Then
Range("p4").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o4").Value) < 10 Then
Range("p4").Font.Color = rgbRed
End If

Range("p5").Value = DateDiff("d", Date, Range("o5").Value) & " Days Until Site Completion"
If DateDiff("d", Date, Range("o5").Value) >= 21 Then
Range("p5").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o5").Value) >= 10 And DateDiff("d", Date, Range("o5").Value) < 21 Then
Range("p5").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o5").Value) < 10 Then
Range("p5").Font.Color = rgbRed
End If

x = Cells(Rows.Count, 2).End(xlUp).Row

'If Not Application.Intersect(Target, Range("k3:z60")) Is Nothing Then

'For i = 8 To x
''
'If Range("m" & i).Value = "" Or Range("o" & i).Value = "" Then
'Range("R" & i).Value = "Enter an Order & a Lead Time"
'End If
'Next i


'End If


End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

ThisWorkbook.Worksheets("Procurement Schedule").Unprotect

Application.ScreenUpdating = False

x = Cells(Rows.Count, 2).End(xlUp).Row

Dim Rng As Range
Set Rng = Range("m8:m" & x)

If Not Application.Intersect(Target, Range("m8:m" & x)) Is Nothing Then

  
    For Each Cell In Rng
        If Cell.Value > "" And Not IsDate(Cell.Value) Then
            Cell.Value = ""
            Cell.Select
            MsgBox "Please Enter a valid date e.g. 25-05-2005 or 25/05/2005"
     
        End If
     

    Next


End If


'Data validation for skid/kiosk/site completion dates
If Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then
Dim Rng9 As Range
Set Rng9 = Range("o3:o5")
    For Each Cell In Rng9
        If Cell.Value > "" And Not IsDate(Cell.Value) Then
            Cell.Value = ""
            Cell.Select
            MsgBox "Please Enter a valid date e.g. 25-05-2005 or 25/05/2005"
        End If
    Next
End If

'Data validation for project delivery date
If Not Application.Intersect(Target, Range("I5")) Is Nothing Then
Dim Rng10 As Range
Set Rng10 = Range("I5")
    For Each Cell In Rng9
        If Cell.Value > "" And Not IsDate(Cell.Value) Then
            Cell.Value = ""
            Cell.Select
            MsgBox "Please Enter a valid date e.g. 25-05-2005 or 25/05/2005"
        End If
    Next
End If


Range("B7").CurrentRegion.Borders.LineStyle = xlContinuous
Range("B7").CurrentRegion.BorderAround _
ColorIndex:=0, Weight:=xlThick
Range("B7:V7").BorderAround ColorIndex:=0, Weight:=xlThick


Columns("A:Z").AutoFit

'if value in 'How many have you ordered?' and 'How many are in stock?' then the 'Quantity left to order' value changes


If Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then

Range("p3").Value = DateDiff("d", Date, Range("o3").Value) & " Days Until Skid Completion"
If DateDiff("d", Date, Range("o3").Value) >= 21 Then
Range("p3").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o3").Value) >= 10 And DateDiff("d", Date, Range("o3").Value) < 21 Then
Range("p3").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o3").Value) < 10 Then
Range("p3").Font.Color = rgbRed
End If

Range("p4").Value = DateDiff("d", Date, Range("o4").Value) & " Days Until Kiosk Completion"
If DateDiff("d", Date, Range("o4").Value) >= 21 Then
Range("p4").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o4").Value) >= 10 And DateDiff("d", Date, Range("o4").Value) < 21 Then
Range("p4").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o4").Value) < 10 Then
Range("p4").Font.Color = rgbRed
End If

Range("p5").Value = DateDiff("d", Date, Range("o5").Value) & " Days Until Site Completion"
If DateDiff("d", Date, Range("o5").Value) >= 21 Then
Range("p5").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o5").Value) >= 10 And DateDiff("d", Date, Range("o5").Value) < 21 Then
Range("p5").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o5").Value) < 10 Then
Range("p5").Font.Color = rgbRed
End If
End If

'expected delivery date Status
If Not Application.Intersect(Target, Range("n8:n" & x)) Is Nothing Or Not Application.Intersect(Target, Range("m8:m" & x)) Is Nothing Or Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then

Dim Rng2 As Range

Set Rng2 = Range("r8:r" & x)

For Each Cell In Rng2

If Cell.Value <> "" Then

If Cell.Value - Range("o3").Value >= 0 Then
    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"


ElseIf Range("o3").Value - Cell.Value < 14 And (Cell.Offset(0, -8).Value = "Skid Mechanical" Or Cell.Offset(0, -8).Value = "Skid Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o3").Value - Cell.Value >= 14 And (Cell.Offset(0, -8).Value = "Skid Mechanical" Or Cell.Offset(0, -8).Value = "Skid Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"

ElseIf Range("o4").Value - Cell.Value < 14 And (Cell.Offset(0, -8).Value = "Kiosk Mechanical" Or Cell.Offset(0, -8).Value = "Kiosk Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o4").Value - Cell.Value >= 14 And (Cell.Offset(0, -8).Value = "Kiosk Mechanical" Or Cell.Offset(0, -8).Value = "Kiosk Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o5").Value - Cell.Value < 14 And (Cell.Offset(0, -8).Value = "Site Mechanical" Or Cell.Offset(0, -8).Value = "Site Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"

ElseIf Range("o5").Value - Cell.Value >= 14 And (Cell.Offset(0, -8).Value = "Site Mechanical" Or Cell.Offset(0, -8).Value = "Site Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
Else

End If

Else
    Cell.Interior.ColorIndex = 0
    

End If
Next
End If


'Actual delivery date Status
If Not Application.Intersect(Target, Range("o8:o" & x)) Is Nothing Or Not Application.Intersect(Target, Range("m8:m" & x)) Is Nothing Or Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then

Dim Rng3 As Range

Set Rng3 = Range("s8:s" & x)

For Each Cell In Rng3

If Cell.Value <> "" Then

If Cell.Value - Range("o3").Value >= 0 Then
    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"


ElseIf Range("o3").Value - Cell.Value < 14 And (Cell.Offset(0, -9).Value = "Skid Mechanical" Or Cell.Offset(0, -9).Value = "Skid Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o3").Value - Cell.Value >= 14 And (Cell.Offset(0, -9).Value = "Skid Mechanical" Or Cell.Offset(0, -9).Value = "Skid Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"

ElseIf Range("o4").Value - Cell.Value < 14 And (Cell.Offset(0, -9).Value = "Kiosk Mechanical" Or Cell.Offset(0, -9).Value = "Kiosk Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o4").Value - Cell.Value >= 14 And (Cell.Offset(0, -9).Value = "Kiosk Mechanical" Or Cell.Offset(0, -9).Value = "Kiosk Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o5").Value - Cell.Value < 14 And (Cell.Offset(0, -9).Value = "Site Mechanical" Or Cell.Offset(0, -9).Value = "Site Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"

ElseIf Range("o5").Value - Cell.Value >= 14 And (Cell.Offset(0, -9).Value = "Site Mechanical" Or Cell.Offset(0, -9).Value = "Site Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
Else

End If

Else
    Cell.Interior.ColorIndex = 0
    

End If
Next
End If

'Determining procurement Status
If Not Application.Intersect(Target, Range("E8:E" & x)) Is Nothing Then

For i = 8 To x
If Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) <= 0 Then
Cells(i, 16).Value = "Complete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) >= 0 Then
Cells(i, 16).Value = "Incomplete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Partially Ordered"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value >= Cells(i, 4).Value Then
Cells(i, 16).Value = "Complete: Fully Ordered"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) = 0 And Cells(i, 4).Value > 0 Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Nothing in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 7).Value <= 0 Then
Cells(i, 16).Value = "Complete: All in Stock"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 4).Value > 0 And Cells(i, 7).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Some in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite

End If

Next i
End If

If Not Application.Intersect(Target, Range("F8:F" & x)) Is Nothing Then

For i = 8 To x
If Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) <= 0 Then
Cells(i, 16).Value = "Complete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) >= 0 Then
Cells(i, 16).Value = "Incomplete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Partially Ordered"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value >= Cells(i, 4).Value Then
Cells(i, 16).Value = "Complete: Fully Ordered"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) = 0 And Cells(i, 4).Value > 0 Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Nothing in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 7).Value <= 0 Then
Cells(i, 16).Value = "Complete: All in Stock"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 4).Value > 0 And Cells(i, 7).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Some in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite

End If

Next i
End If

'data validation for column k (unit cost)
If Not Application.Intersect(Target, Range("k8:k" & x)) Is Nothing Then
Dim Rng5 As Range

    Set Rng5 = Range("K8:k" & x)
    For Each Cell In Rng5

    If Cell.Value < 0 Then
    MsgBox "Please enter a positive number"
    Cell.Select
    Cell.Value = ""
    End If
    
    If Not IsNumeric(Cell.Value) Then
    MsgBox "Please Enter a Numeric Value"
    Cell.Select
    Cell.Value = ""
    End If

    Next
    
End If

'data validation for column O (Actual Lead Time)
If Not Application.Intersect(Target, Range("o8:o" & x)) Is Nothing Then
Dim Rng6 As Range

    Set Rng6 = Range("o8:o" & x)
    For Each Cell In Rng6

    If Cell.Value < 0 Then
    MsgBox "Please enter a positive number"
    Cell.Select
    Cell.Value = ""
    End If
    
    If Not IsNumeric(Cell.Value) Then
    MsgBox "Please Enter a Numeric Value"
    Cell.Select
    Cell.Value = ""
    End If

    Next
    
End If

'data validation for column E (Number Ordered)
If Not Application.Intersect(Target, Range("e8:e" & x)) Is Nothing Then
Dim Rng7 As Range

    Set Rng7 = Range("e8:e" & x)
    For Each Cell In Rng7

    If Cell.Value < 0 Then
    MsgBox "Please enter a positive number"
    Cell.Select
    Cell.Value = ""
    End If
    
    If Not IsNumeric(Cell.Value) Then
    MsgBox "Please Enter a Numeric Value"
    Cell.Select
    Cell.Value = ""
    End If

    Next
    
End If


'data validation for column E (Number In Stock)
If Not Application.Intersect(Target, Range("f8:f" & x)) Is Nothing Then
Dim Rng8 As Range

    Set Rng8 = Range("f8:f" & x)
    For Each Cell In Rng8

    If Cell.Value < 0 Then
    MsgBox "Please enter a positive number"
    Cell.Select
    Cell.Value = ""
    End If
    
    If Not IsNumeric(Cell.Value) Then
    MsgBox "Please Enter a Numeric Value"
    Cell.Select
    Cell.Value = ""
    End If

    Next
    
End If

'Determing delivery date status

'If Not Application.Intersect(Target, Range("r8:r" & x)) Is Nothing Or Not Application.Intersect(Target, Range("O3")) Is Nothing Then
'For i = 8 To x
'If (Cells(i, 10).Value = "Skid Mechanical" Or Cells(i, 10).Value = "Skid Electrical") And Cells(i, 18).Value < (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbRed
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf (Cells(i, 10).Value = "Skid Mechanical" Or Cells(i, 10).Value = "Skid Electrical") And Cells(i, 18).Value > (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbGreen
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf Cells(i, 18).Value < 0 Then
'Cells(i, 18).Interior.ColorIndex = 0
'Cells(i, 18).Font.Color = rgbBlack
'End If
'
'If (Cells(i, 10).Value = "Kiosk Mechanical" Or Cells(i, 10).Value = "Kiosk Electrical") And Cells(i, 18).Value < (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbRed
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf (Cells(i, 10).Value = "Kiosk Mechanical" Or Cells(i, 10).Value = "Kiosk Electrical") And Cells(i, 18).Value > (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbGreen
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf Cells(i, 18).Value < 0 Then
'Cells(i, 18).Interior.ColorIndex = 0
'Cells(i, 18).Font.Color = rgbBlack
'End If
'
'If (Cells(i, 10).Value = "Site Mechanical" Or Cells(i, 10).Value = "Site Electrical") And Cells(i, 18).Value < (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbRed
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf (Cells(i, 10).Value = "Site Mechanical" Or Cells(i, 10).Value = "Site Electrical") And Cells(i, 18).Value > (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbGreen
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf Cells(i, 18).Value < 0 Then
'Cells(i, 18).Interior.ColorIndex = 0
'Cells(i, 18).Font.Color = rgbBlack
'End If
'
'
'Next i
'End If


For i = 1 To x

If Worksheets("Procurement Schedule").Range("H" & i).Value = "Kiosk Electrical" Then
Range("h" & i).Interior.Color = rgbDarkGreen
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("H" & i).Value = "Kiosk Mechanical" Then
Range("h" & i).Interior.Color = rgbYellow
Range("h" & i).Font.Color = rgbBlack
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Skid Electrical" Then
Range("h" & i).Interior.Color = rgbBlue
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Skid Mechanical" Then
Range("h" & i).Interior.Color = rgbGrey
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Site Electrical" Then
Range("h" & i).Interior.Color = rgbPurple
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Site Mechanical" Then
Range("h" & i).Interior.Color = rgbLightGrey
Range("h" & i).Font.Color = rgbBlack
End If
Next i

'ThisWorkbook.Worksheets("Procurement Schedule").Protect userinterfaceonly:=True

Application.ScreenUpdating = True

End Sub
 
A quick scan of your code suggests it's using too many IF ELSE conditions and this may also be adding to the problem.

I've tended to find, longer code is, more unknown effects there are when things go wrong and then identifying cause has a similar increase in complexity.

You can probably put a lot of those IF ELSE tests into a hidden sheet and use the code to pull the results of the tests to do what you need, but this is a guess, based on what's been posted, without knowing your workbook structure, layout data flows or formulae complexity.

Consider SELECT CASE instead of IF ELSE where you have more than 1 condition to test for in your code, but, unfortunately there is just too much code to offer to revise for you (others may).
 
Upvote 0

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Hi,

I think I've solved the problem as to why it is continually crashing and there is no way you could have solved it with the information I had provided.

I wanted to have a doughnut chart with an accompanying data table in my spreadsheet but it wasn't possible. the get around was to create a table and use the snap shot feature within Excel (See below) but for some reason it was taking multiple snaps in the background. i deleted it and now it runs rapidly especially now that I've added the disable events code. Why I never thought to delete before now, I'll never know.

However, I have no idea why it is taking these multiple snaps in the background. It is unfortunate as it was a handy feature. I've asked around about this but it's not something people seem to be overly familiar with. Don't know if you have any suggestions?

1586424594495.png
 
Upvote 0
No ideas I'm afraid, I've not used snap shot feature actually! Without your file, difficult to offer reasons for the behaviour.

However, with the code, I really do think it would benefit to learn about SELECT CASE statements, potentially helping make your code easier to read and debug.

Anyway, pleased issue is resolved :)
 
Upvote 0
Thanks,

I will also modify my code based on your suggestions. I'm a bit of a VBA novice, so I reckon there is probably a lot of inefficiencies within my code.

In a way, I'm quite glad I had these issues though as it has made me aware of this forum and it made me research ways of condensing your code and speeding things up i.e. not repeatedly selecting cells within code, utilising arrays, deactivating events and even just utilising the worksheet functions as oppose to trying to be smart and use a for loop to go through all your cells etc.

Cheers
 
Upvote 0

Forum statistics

Threads
1,214,965
Messages
6,122,499
Members
449,089
Latest member
Raviguru

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top