shan
11-10-2015, 12:20 AM
Hello All,
I am facing a problem. When I am running the below code on a higher no. of rows the system prompts "Overflow" message. But on a less no. of rows its working absolutely fine.
Can you please assist me understanding the error in the code so which I can rectify.
Below is the macro code..
Sub HourSpike()
Application.ScreenUpdating = False
Dim i As Integer
Dim Lastrow As Long
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range("H2:H" & Lastrow).Formula = "=RC[-2]/RC[-1]"
Columns("H:H").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#DIV/0!", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Style = "Percent"
ActiveWorkbook.Worksheets("Hourly").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hourly").Sort.SortFields.Add Key:=Range("D1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Hourly").Sort.SortFields.Add Key:=Range("C1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Hourly").Sort.SortFields.Add Key:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hourly").Sort
.SetRange ThisWorkbook.ActiveSheet.UsedRange
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To Lastrow
If Cells(i, 1).Value = Cells(i - 1, 1).Value And Cells(i, 3).Value = Cells(i - 1, 3).Value And Cells(i, 4).Value = Cells(i - 1, 4).Value Then
If Cells(i, 8) > Cells(i - 1, 8) + 0.01 Then Range(Cells(i, 1), Cells(i, 8)).Interior.ColorIndex = 6
End If
Next
Application.ScreenUpdating = True
End Sub
I am facing a problem. When I am running the below code on a higher no. of rows the system prompts "Overflow" message. But on a less no. of rows its working absolutely fine.
Can you please assist me understanding the error in the code so which I can rectify.
Below is the macro code..
Sub HourSpike()
Application.ScreenUpdating = False
Dim i As Integer
Dim Lastrow As Long
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range("H2:H" & Lastrow).Formula = "=RC[-2]/RC[-1]"
Columns("H:H").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#DIV/0!", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Style = "Percent"
ActiveWorkbook.Worksheets("Hourly").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hourly").Sort.SortFields.Add Key:=Range("D1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Hourly").Sort.SortFields.Add Key:=Range("C1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Hourly").Sort.SortFields.Add Key:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hourly").Sort
.SetRange ThisWorkbook.ActiveSheet.UsedRange
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To Lastrow
If Cells(i, 1).Value = Cells(i - 1, 1).Value And Cells(i, 3).Value = Cells(i - 1, 3).Value And Cells(i, 4).Value = Cells(i - 1, 4).Value Then
If Cells(i, 8) > Cells(i - 1, 8) + 0.01 Then Range(Cells(i, 1), Cells(i, 8)).Interior.ColorIndex = 6
End If
Next
Application.ScreenUpdating = True
End Sub