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