Tried searching but nothing seems to specifically answer what I'm after..
For some reason it seems the code is running too fast and skipping the code within the IF section.
So far I've tried adding Application.Wait, creating a separate sub with the IF'd code to be called out in an effort to slow it down. Nothing has proved successful.
The basic purpose is to import a sheet, copy it to the active workbook, then delete rows which are red and finish by deleting the imported sheets.
Everything works except the red rows remain on the target sheet.
Stepping through the process with F8 yields a successful result!
'FOR THE DEBUG TIMER
Dim StartTime As Double
Dim MinutesElapsed As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayAlerts = False
Dim targetWorkbook As Workbook
'Assume active workbook as the destination workbook
Set targetWorkbook = Application.ActiveWorkbook
'Import the Metadata
Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook
Dim vfilename As Variant
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks, *.xlsm; *.xlsx", Title:="Open
If sImportFile = "False" Then
MsgBox "No File Selected!"
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
StartTime = Timer
Set wbBk = Workbooks(sFile)
'COPY TV SHOWS SHEET
If SheetExists("TV") Then
Set wsSht = .Sheets("TV")
ActiveSheet.Name = "TV 2"
MsgBox "There is no sheet with name :TV in:" & vbCr & .Name
Set wsSht = Nothing
Set sThisBk = Nothing
'Set sheets to TV
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets("TV")
Dim sourceSheet As Worksheet
Set sourceSheet = targetWorkbook.Worksheets("TV 2")
'Find Last Rows
Dim LastRow As Long
LastRow = .Cells(rows.Count, "A").End(xlUp).Row
Dim LastRow2 As Long
LastRow2 = .Cells(rows.Count, "C").End(xlUp).Row
'Remove RED expired rows
For iCntr = LastRow To 1 Step -1
If Cells(iCntr, 2).Interior.ColorIndex = 3 Then
'Variables for TV
targetSheet.Range("B4:B" & LastRow).Value = sourceSheet.Range("E2:E" &
sourceSheet.Range("E2:E" & LastRow).Copy
targetSheet.Range("B4:B" & LastRow).PasteSpecial xlFormats
Set targetSheet = Nothing
Set sourceSheet = Nothing
'Delete imported sheets
LastRow = Sheets("TV").Cells(rows.Count, "B").End(xlUp).Row
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes",
Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True