Hello folks,
I have the following code running on a sheet, with currently around 10000 lines of data. In the future this may even be 50000. This code runs through a lot of cells (H11:BG10000) and checks for yellow highlighted cells, and then some part of the code does one thing and the rest something else, and because of this it is taking me a LOT of time, I like waited for 9 minutes, and then pressed escape to break it. There is no way I can submit this code with the file, as it will not be feasible for the users to wait for so long. The file is heavily formatted from A to BG cells and as well as a huge number of cells have formulas referencing various other sheets. I did what I could but no success. Any ideas on how to go with this quickly:
Dim ws1 As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlAutomatic
Application.EnableEvents = False
Set ws1 = ThisWorkbook.Sheets("Main Data")
Dim lr As Long
lr = Cells(Rows.Count, "D").End(xlUp).Row
On Error Resume Next
'Assuming you want to fill blanks in column A
With Range("A11:A" & lr).SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=RC[5]&RC[6]&RC[1]&RC[2]&RC[3]&RC[4]"
End With
On Error Resume Next
For Each rng In ActiveSheet.Range("H11:BG10000")
If rng.Interior.ColorIndex = 6 Then
rng.End(xlToRight).Value = "Check"
End If
Next
'restoring colours for columns B through G
Range("B11").Select
Range(Selection, Selection.Offset(0, 1)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("F11").Select
Range(Selection, Selection.Offset(0, 1)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("D11").Select
Range(Selection, Selection.Offset(0, 1)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
I have the following code running on a sheet, with currently around 10000 lines of data. In the future this may even be 50000. This code runs through a lot of cells (H11:BG10000) and checks for yellow highlighted cells, and then some part of the code does one thing and the rest something else, and because of this it is taking me a LOT of time, I like waited for 9 minutes, and then pressed escape to break it. There is no way I can submit this code with the file, as it will not be feasible for the users to wait for so long. The file is heavily formatted from A to BG cells and as well as a huge number of cells have formulas referencing various other sheets. I did what I could but no success. Any ideas on how to go with this quickly:
Dim ws1 As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlAutomatic
Application.EnableEvents = False
Set ws1 = ThisWorkbook.Sheets("Main Data")
Dim lr As Long
lr = Cells(Rows.Count, "D").End(xlUp).Row
On Error Resume Next
'Assuming you want to fill blanks in column A
With Range("A11:A" & lr).SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=RC[5]&RC[6]&RC[1]&RC[2]&RC[3]&RC[4]"
End With
On Error Resume Next
For Each rng In ActiveSheet.Range("H11:BG10000")
If rng.Interior.ColorIndex = 6 Then
rng.End(xlToRight).Value = "Check"
End If
Next
'restoring colours for columns B through G
Range("B11").Select
Range(Selection, Selection.Offset(0, 1)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("F11").Select
Range(Selection, Selection.Offset(0, 1)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("D11").Select
Range(Selection, Selection.Offset(0, 1)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub