End if without block if!!!!

[rfletcher35]

Guys I've got this code but when I run it I get the error "End if, without block if"

Can you please tell me where I'm going wrong??

Private Sub CmdButtonInsert_Click()
'ADD/APPEND DATE TO WORKSHEET.
On Error GoTo DoesNotFit
Dim strAddress As String
Dim strFormat As String
Dim blnExists As Boolean
Dim objLB As MSForms.ListBox
Dim dteValue As Variant 'date
Dim d As Long 'day
Dim i As Long
Dim M As Long
Dim Y As Long 'year
Dim strmyvalue As Date
Dim ValidDate As Boolean

For i = 1 To Me.Frame1.Controls.Count
If Me.Controls("ListBox" & i).ListIndex > -1 Then
Set objLB = Me.Controls("ListBox" & i)
On Error Resume Next
'Returns a string
d = CLng(objLB.Value)
On Error GoTo DoesNotFit
Exit For
End If
Next 'i
If Not d > 0 Then Err.Raise 56789, , "Date is not valid - Unable to insert"
DoEvents

'SAVE INFO IN vFORMULAS
strAddress = ActiveCell.Address(True, True, xlA1, True, Nothing)
i = 0
On Error Resume Next
With Application.WorksheetFunction
i = .Match(strAddress, .Index(vFormulas, 0, 3), 0)
End With
On Error GoTo DoesNotFit
'Only if a new cell.
If i <> 0 And i <= MAX_UNDO Then
'Cell address is in vFormulas
M = i
blnExists = True
Else
M = 0
For Y = LBound(vFormulas, 1) To UBound(vFormulas, 1)
If Len(vFormulas(Y, 3)) > 0 Then M = M + 1
Next
If M >= MAX_UNDO Then
M = MAX_UNDO
'Shuffle all array values up one row
For Y = 1 To (MAX_UNDO - 1)
For i = 1 To 3
vFormulas(Y, i) = vFormulas(Y + 1, i)
Next
Next
vFormulas(MAX_UNDO, 1) = Empty
vFormulas(MAX_UNDO, 2) = Empty
vFormulas(MAX_UNDO, 3) = Empty
Else
M = M + 1
End If
End If

'Only save data from new cell locations.
If Not blnExists Then
vFormulas(M, 1) = ActiveCell.Formula
vFormulas(M, 2) = ActiveCell.NumberFormat
vFormulas(M, 3) = strAddress
If M = 1 Then
cmdButtonInfo.ForeColor = vbBlue
cmdButtonInfo.Caption = "Undo"
If Val(Application.Version) >= 9 Then _
cmdButtonInfo.ControlTipText = "undo limited to the last " & MAX_UNDO & " inserts"
cmdButtonInsert.ControlTipText = "to append date: press shift key when inserting"
ElseIf M = 3 Then
cmdButtonInfo.ControlTipText = vbNullString
cmdButtonInsert.ControlTipText = vbNullString
ElseIf M = MAX_UNDO Then
cmdButtonInfo.ForeColor = vbRed
If Val(Application.Version) >= 9 Then _
cmdButtonInfo.ControlTipText = "undo limited to the last " & MAX_UNDO & " inserts"
Else
cmdButtonInfo.ForeColor = vbBlue
If M = (MAX_UNDO - 1) Then cmdButtonInfo.ControlTipText = vbNullString
End If
End If
End If
End If

'Changing cell dependents creates error values in cells with formulas
' so convert cell to value.
On Error Resume Next
ActiveCell.Value2 = ActiveCell.Value2
If Err.Number <> 0 Then 'belts and suspenders
On Error GoTo DoesNotFit
ActiveCell.Copy
ActiveCell.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
On Error GoTo DoesNotFit
End If

'INSERT DATE IN CELLL
'Determine date - month is spelled out.
i = Me.sbMonth.Value
Y = Me.sbYear.Value
If objLB.ListIndex = 0 And objLB.Value > 7 Then
i = i - 1
If i = 0 Then
i = 12
Y = Y - 1
End If
End If
'DateSerial allows for international formats - DateValue does not.
dteValue = VBA.DateSerial(Y, i, d) 'Hans Vogelaar
'If GetKeyState(vbKeyShift) < 0 Then 'APPENDING
' If the cell already has a date add this date to it
'If Not IsEmpty(ActiveCell) Then
'Using Str function will not add leading space.
'ActiveCell.Value = ActiveCell.Value & " " & dteValue
'Else 'blank cell
' Find previous date value ......... <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Activate

strmyvalue = ActiveCell.Offset(0, -1).Value

If strmyvalue <= dteValue Then

ActiveCell.Value = dteValue
Else
MsgBox ("Invalid date")
Exit Sub
End If

'End If
'Else 'INSERTING

'if ActiveCell.Value = dteValue
'End If
Me.Caption = VBA.UCase$(Format$(dteValue, "yyyy - mmmm ")) & d
Me.Frame1.SetFocus
Set objLB = Nothing


Me.Hide


Thanks

Fletch

 

[bhos123]

if you have a IF loop inside the For you should also have End if before the Next.

if you have For inside a IF, then you should have Next before the end if

 

[rfletcher35]

I see what you are saying but I have looked through my code and cannot see it, are you saying you can?

 

[bhos123]

For Y = LBound(vFormulas, 1) To UBound(vFormulas, 1)
If Len(vFormulas(Y, 3)) > 0 Then M = M + 1
Next

You should have End if before Next

 

[rfletcher35]

I placed an end if there and it returned the same error?

 

[bhos123]

Private Sub CmdButtonInsert_Click()
'ADD/APPEND DATE TO WORKSHEET.
On Error GoTo DoesNotFit
Dim strAddress As String
Dim strFormat As String
Dim blnExists As Boolean
Dim objLB As MSForms.ListBox
Dim dteValue As Variant 'date
Dim d As Long 'day
Dim i As Long
Dim M As Long
Dim Y As Long 'year
Dim strmyvalue As Date
Dim ValidDate As Boolean

For i = 1 To Me.Frame1.Controls.Count
If Me.Controls("ListBox" & i).ListIndex > -1 Then
Set objLB = Me.Controls("ListBox" & i)
On Error Resume Next
'Returns a string
d = CLng(objLB.Value)
On Error GoTo DoesNotFit
Exit For
End If
Next 'i
If Not d > 0 Then Err.Raise 56789, , "Date is not valid - Unable to insert"
DoEvents

'SAVE INFO IN vFORMULAS
strAddress = ActiveCell.Address(True, True, xlA1, True, Nothing)
i = 0
On Error Resume Next
With Application.WorksheetFunction
i = .Match(strAddress, .Index(vFormulas, 0, 3), 0)
End With
On Error GoTo DoesNotFit
'Only if a new cell.
If i <> 0 And i <= MAX_UNDO Then
'Cell address is in vFormulas
M = i
blnExists = True
Else
M = 0
For Y = LBound(vFormulas, 1) To UBound(vFormulas, 1)
If Len(vFormulas(Y, 3)) > 0 Then M = M + 1
End If
Next
End If
End If

If M >= MAX_UNDO Then
M = MAX_UNDO
'Shuffle all array values up one row
For Y = 1 To (MAX_UNDO - 1)
For i = 1 To 3
vFormulas(Y, i) = vFormulas(Y + 1, i)
Next
Next
vFormulas(MAX_UNDO, 1) = Empty
vFormulas(MAX_UNDO, 2) = Empty
vFormulas(MAX_UNDO, 3) = Empty
Else
M = M + 1
End If


'Only save data from new cell locations.
If Not blnExists Then
vFormulas(M, 1) = ActiveCell.Formula
vFormulas(M, 2) = ActiveCell.NumberFormat
vFormulas(M, 3) = strAddress
End If

If M = 1 Then
cmdButtonInfo.ForeColor = vbBlue
cmdButtonInfo.Caption = "Undo"
End If

If Val(Application.Version) >= 9 Then _
cmdButtonInfo.ControlTipText = "undo limited to the last " & MAX_UNDO & " inserts"
cmdButtonInsert.ControlTipText = "to append date: press shift key when inserting"
ElseIf M = 3 Then
cmdButtonInfo.ControlTipText = vbNullString
cmdButtonInsert.ControlTipText = vbNullString
ElseIf M = MAX_UNDO Then
cmdButtonInfo.ForeColor = vbRed
If Val(Application.Version) >= 9 Then _
cmdButtonInfo.ControlTipText = "undo limited to the last " & MAX_UNDO & " inserts"
Else
cmdButtonInfo.ForeColor = vbBlue
End If

If M = (MAX_UNDO - 1) Then cmdButtonInfo.ControlTipText = vbNullString
End If


'Changing cell dependents creates error values in cells with formulas
' so convert cell to value.
On Error Resume Next
ActiveCell.Value2 = ActiveCell.Value2
If Err.Number <> 0 Then 'belts and suspenders
On Error GoTo DoesNotFit
ActiveCell.Copy
ActiveCell.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
On Error GoTo DoesNotFit
End If

'INSERT DATE IN CELLL
'Determine date - month is spelled out.
i = Me.sbMonth.Value
Y = Me.sbYear.Value
If objLB.ListIndex = 0 And objLB.Value > 7 Then
i = i - 1
If i = 0 Then
i = 12
Y = Y - 1

'DateSerial allows for international formats - DateValue does not.
dteValue = VBA.DateSerial(Y, i, d) 'Hans Vogelaar
'If GetKeyState(vbKeyShift) < 0 Then 'APPENDING
' If the cell already has a date add this date to it
'If Not IsEmpty(ActiveCell) Then
'Using Str function will not add leading space.
'ActiveCell.Value = ActiveCell.Value & " " & dteValue
'Else 'blank cell
' Find previous date value ......... <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Activate

strmyvalue = ActiveCell.Offset(0, -1).Value

If strmyvalue <= dteValue Then

ActiveCell.Value = dteValue
Else
MsgBox ("Invalid date")
Exit Sub
End If

'End If
'Else 'INSERTING

'if ActiveCell.Value = dteValue
'End If
Me.Caption = VBA.UCase$(Format$(dteValue, "yyyy - mmmm ")) & d
Me.Frame1.SetFocus
Set objLB = Nothing


I have changed Ifs and Endifs , please check now.

 

[rfletcher35]

Thanks all working now.

 

[Craggs82]

For Y = LBound(vFormulas, 1) To UBound(vFormulas, 1)
If Len(vFormulas(Y, 3)) > 0 Then M = M + 1
Next

You should have End if before Next

Single line IF statements like this don't need an End IF.