Hello,
I'm getting a Run-Time Error 6: Overflow on the code below. It's strange because this code as been working perfect for 10 months and now it's spitting out this error. It stops on the "For Loop" where "R = Range("F" & p)". Can anyone please help me understand whats going wrong?
Thank you!
Dim i As Long
Dim p As Long
Dim Y As String
Dim W As String
Dim Z As String
Dim LR As String
Dim Cell As Range
Dim intCol As Integer
Dim NumDays As Integer
Dim var1 As String
var1 = "X"
LR = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Today = Date
NumDays = 10
dateStamp = "12/31/2020"
For p = 2 To LR
X = Range("C" & p)
X = Left(X, 1)
R = Range("F" & p)
R = Left(R, 10)
For Each Cell In Range("F" & p)
If Cell.Value = " " Then
Cell.Offset(0, 0).Value = dateStamp
End If
Next
For Each Cell In Range("F" & p)
If InStr(R, "-") Then
Cell.Offset(0, 0).Value = dateStamp
End If
Next
If CDate(Cells(p, 6)) = Today + NumDays And X = var1 Then Range("C" & p).Font.Color = vbBlue
'All cells in column loop that are marked are to mark the whole row that its in
For Each Cell In Range("C" & p)
If Cell.Font.Color = vbBlue Then
Cell.Offset(0, -1).Font.Color = vbBlue
Cell.Offset(0, -2).Font.Color = vbBlue
Cell.Offset(0, 1).Font.Color = vbBlue
Cell.Offset(0, 2).Font.Color = vbBlue
Cell.Offset(0, 3).Font.Color = vbBlue
End If
Next
' All cells that haven't been marked are set to = ""
If Range("F" & p).Font.Color <> vbBlue Then Range("F" & p).Value = ""
For Each Cell In Range("F" & p)
If Cell.Value = "" Then
Cell.Offset(0, -1).Value = ""
Cell.Offset(0, -2).Value = ""
Cell.Offset(0, -3).Value = ""
Cell.Offset(0, -4).Value = ""
Cell.Offset(0, -5).Value = ""
End If
Next
'
Next
For intCol = 1 To 6 'cols A to F
Range(Cells(2, intCol), Cells(p, intCol)). _
SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
Next intCol
Call BorderUp
' Sheets("Sheet1").Range("A1").Select
' Selection.CurrentRegion.Select
' Sheets("Sheet2").Select
' Sheets("Sheet2").Paste
If Sheets("Sheet2").Range("B2").Value = "" Then Exit Sub
Sheets("Sheet2").Range("A1").Select
Selection.CurrentRegion.Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
Worksheets("Sheet2").Range("A:F").ClearContents
Columns.AutoFit
Application.ScreenUpdating = True
Bookmarks