Compile error: End If without block IF

[Casey]

I can't seem to find why I'm getting this error. I have four If statements
and four End If statements. The error is hitting on the second "End If "
statement. Here is my Code:

Sub TransferToPO()
Dim rng1 As Range, rng2 As Range, rng3 As Range

Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim CopyRow3 As Long
Dim Entries As Long
Dim i As Long
Dim N As Variant
Dim Cnt As Long
Dim Cnt2 As Long
Dim Cnt3 As Long
Dim Msg As Integer
Dim Response As Integer

Msg = MsgBox("Have you selected the items you want exported?" _
& (Chr(13)) & "This will export all selected items to the " _
& " Purchase Order." _
& (Chr(13)) & "Are you ready to create a Purchase Order?", _
vbYesNo + vbQuestion, "Export to Purchase Order")
If Msg = 6 Then
Application.ScreenUpdating = False
Call Add_New_PO
Cnt = 0
Cnt3 = 0
Set wks1 = Worksheets("Materials Summary")
Set wks2 = Worksheets("Purchase Order")

Set rng1 = Range("TopRow1")
Set rng2 = Range("Below_Entry_Bottom_RowPO").Offset(-1)
Set rng1 = Intersect(rng1, rng1.Parent.Columns(1))
Set rng2 = Intersect(rng2, rng2.Parent.Columns(1))
Set rng3 = rng1.Parent.Range(rng1, rng2)
Cnt2 = rng3.SpecialCells(xlBlanks).Count
CopyRow3 = rng1.Row
Entries = Excel.WorksheetFunction.CountA(wks1.Range("A:A"))

For i = 8 To Entries + 100
N = wks1.Cells(i, 1).Value
If N = "X" Then Cnt = Cnt + 1
Cnt3 = Cnt2 - Cnt
If Cnt3 < 0 Then
Call InsertBlankLastRow_CheckIfBlank
With wks2
.Unprotect ("geekk")
.Cells(CopyRow3, 1).Value = wks1.Cells(i, 3).Value
.Cells(CopyRow3, 4).Value = wks1.Cells(i, 2).Value
.Cells(CopyRow3, 5).Value = wks1.Cells(i, 4).Value
.Protect ("geekk")
End With
CopyRow3 = CopyRow3 + 1
End If
End If
Next i

wks2.Range("E8").Activate
Application.ScreenUpdating = True
End If
If Msg = 7 Then
Exit Sub

End If
End Sub

 

[Casey]

That was the problem thank you Stefi.