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.
--
Casey




"Stefi" wrote:

> See comment in the code below!
> Regards,
> Stefi
>
>
> „Caseyâ€� ezt Ã*rta:
>
> > 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
>
> This is a complete IF line in itself which doesn't require an ENDIF, but
> still you gave it one (see below!)
>
>
> > 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
>
>
> This is the redundant ENDIF
> > End If
>
>
> > Next i
> >
> > wks2.Range("E8").Activate
> > Application.ScreenUpdating = True
> > End If
> > If Msg = 7 Then
> > Exit Sub
> >
> > End If
> > End Sub
> >
> >
> > --
> > Casey
> >
> >