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!
Sub Grab_Data()
'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
Workbook")
If sImportFile = "False" Then
MsgBox "No File Selected!"
Exit Sub
Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile
StartTime = Timer
Set wbBk = Workbooks(sFile)
With wbBk
'COPY TV SHOWS SHEET
If SheetExists("TV") Then
Set wsSht = .Sheets("TV")
wsSht.Copy after:=sThisBk.Sheets(Sheets.Count)
ActiveSheet.Name = "TV 2"
Else
MsgBox "There is no sheet with name :TV in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Set wsSht = Nothing
Set sThisBk = Nothing
'#########TV##########
'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
With sourceSheet
LastRow = .Cells(rows.Count, "A").End(xlUp).Row
End With
Dim LastRow2 As Long
With targetSheet
LastRow2 = .Cells(rows.Count, "C").End(xlUp).Row
End With
'Remove RED expired rows
With sourceSheet
For iCntr = LastRow To 1 Step -1
If Cells(iCntr, 2).Interior.ColorIndex = 3 Then
rows(iCntr).EntireRow.Delete
Debug.Print iCntr
End If
Next
End With
'Variables for TV
targetSheet.Range("B4:B" & LastRow).Value = sourceSheet.Range("E2:E" &
LastRow).Value
sourceSheet.Range("E2:E" & LastRow).Copy
targetSheet.Range("B4:B" & LastRow).PasteSpecial xlFormats
Set targetSheet = Nothing
Set sourceSheet = Nothing
'Delete imported sheets
With ActiveWorkbook
.Sheets("TV 2").Delete
.Sheets("Movies 2").Delete
.Sheets("Audio 2").Delete
End With
LastRow = Sheets("TV").Cells(rows.Count, "B").End(xlUp).Row
End With
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",
vbInformation
End Sub
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
End Function
With sourceSheetbut inside that block none of your range references are scoped to thatWith. egIf Cells(iCntr, 2).Interior.ColorIndex = 3 Thenshould beIf .Cells(iCntr, 2).Interior.ColorIndex = 3 Then