Block if without end if как исправить

Добрый день!Подскажите, пожалуйста, мне Excel ругается на последний end if, говорит что мой end if without block if, но у меня же кол-во if и end if одинаковое.Если удаляю его, то начинает ругаться на Next k without For.Как же быть? Куда только не ставил его. Код Option Explicit Sub checking() Dim a() Dim b() Dim i As Long Dim k As Long Dim j As Long Dim iLastRow As Long a = Sheets("ÎèÎ").[A1].CurrentRegion.Value b =...
Option Explicit

Sub checking()


Dim a()
Dim b()
Dim i As Long
Dim k As Long
Dim j As Long
Dim iLastRow As Long

a = Sheets("ÎèÎ").[A1].CurrentRegion.Value
b = Sheets("ÎÑÂ").[A1].CurrentRegion.Value
ReDim c(1 To UBound(a) + UBound(b), 1 To 12)


j = 1

For i = 1 To UBound(a)
    If a(i, 7) Like "*ÎÎÎ*" Or _
              a(i, 7) Like "*ÀÎ*" Or _
              a(i, 7) Like "*""*""*" Or _
              UBound(Split(a(i, 7), " "), 1) + 1 >= 5 Then
        For k = 1 To UBound(b)

         If a(i, 7) = b(k, 1) Then
                    c(j, 1) = a(i, 1)
                    c(j, 2) = a(i, 2)
                    c(j, 3) = a(i, 3)
                    c(j, 4) = a(i, 4)
                    c(j, 5) = a(i, 5)
                    c(j, 6) = a(i, 6)
                    c(j, 7) = a(i, 7)
                    c(j,  = a(i, 
                    c(j, 9) = b(k, 1)
                    c(j, 10) = b(k, 2)
                    c(j, 11) = b(k, 3)
                    c(j, 12) = b(k, 4)
                   j = j + 1
                   
        Else

            With CreateObject("VBScript.RegExp")
            .Pattern = "[à-ÿÀ-߸¨]+s[à-ÿÀ-߸¨]{1}[.]{1}[à-ÿÀ-߸¨]{1}[.]{1}$" 
                 If .Test(a(i, 7)) Then
        
                        If a(i, 7) = b(k, 1) _
                         Or Right(a(i, 7), 4) = Right(b(k, 1), 4) _
                         Or Left(a(i, 7), InStr(a(i, 7), " ") - 2) = Left(a(k, 1), InStr(a(i, 7), " ") - 2) Then
  

                    c(j, 1) = a(i, 1)
                    c(j, 2) = a(i, 2)
                    c(j, 3) = a(i, 3)
                    c(j, 4) = a(i, 4)
                    c(j, 5) = a(i, 5)
                    c(j, 6) = a(i, 6)
                    c(j, 7) = a(i, 7)
                    c(j,  = a(i, 
                    c(j, 9) = b(k, 1)
                    c(j, 10) = b(k, 2)
                    c(j, 11) = b(k, 3)
                    c(j, 12) = b(k, 4)
                   j = j + 1
   
End If
End If
End If

Next k
             Next i

Sheets("Èòîã").[A1].Resize(UBound(c), 12) = c


End Sub

Today I’ll show you how to resolve the error “End If without block If” in VBA. But first, you have to understand the “If” statement in order to fix the issue.

Contents

  • The IF statement and its various forms
  • The Compile Error “End If without Block If:
    • Rule 1: End If with single line statement
    • Rule 2: Extra End If statements
    • Rule 3: Forgetting part of your deleted code
  • Summary

The IF statement and its various forms

The If statement is a conditional clause that helps us to run code using a condition that is decided during runtime. You might wonder, “What is the need to decide the condition during runtime? Can’t we decide that earlier?” In reality, there are many situations where an action needs to be performed only if certain criteria are met or a condition is fulfilled. Sometimes this check might even depend on the user’s input value.

For example, let us imagine that a bank offers 8% ROI on fixed deposit accounts if the customer is a senior citizen and only 6% ROI for other customers. In this case, the code that calculates the interest and maturity amount should both a) consider the age of the customer and b) use a condition to use different values for senior and non-senior citizens. This is where an “If conditional statement” steps in.

Now let’s see the code for the above scenario assuming that one must be 60 years old to be called a senior citizen.

Sub sample_coding()
'declaration of variables
Dim matamt, prinamt, roi, term, custage
‘ receive input from user
custage = InputBox("Enter the age of the customer")
‘ assign some values
prinamt = 10000 ' Principal amount
term = 2 ' 2 years
' decide the roi value
If custage < 60 Then
    roi = 6
Else
    roi = 8
End If
' formula to calculate the FD maturity amount.
matamt = prinamt + (prinamt * roi * term / 100)
‘ printing the output
Debug.Print matamt
End Sub

Looking at the example above, we see that the syntax for using a simple If statement is

If <condition> Then

<code>

End If

But the same conditional statement has different forms  as listed below.

  1. A simple If Block
  2. An If – Else block
  3. An Else-If block
  4. Nested If block

The Compile Error “End If without Block If:

This is a simple compile time error that’s thrown when the code containing any If blocks do not comply with the syntax (or) such a statement does not exist.

Here are some instances where this error might occur

Rule 1: End If with single line statement

If the single line of code to be executed is placed in the same line as the “If – then” statement, then the “End If” statement needs to be omitted. In other words, the If statement is considered complete without an “End If” statement in cases where the conditional code is placed in the same line.

If &amp;amp;lt;condition&amp;amp;gt; Then &amp;amp;lt;code&amp;amp;gt;

For example:

The If condition in the above code can be rewritten using this rule to avoid the compile error “End if without block If”.

' Fix an roi in common
	roi = 8 
'Change the value for non-senior citizens alone using the rule 1
If custage &amp;amp;lt; 60 Then roi = 6
' comment or remove the end if statement to fix the error.
'End If 

According to Rule 1, if “End If” is used in the above code, you will encounter the error “End If without block If”. So, do not forget to remove it.

If you’re using nested if conditions, ensure that every “If” statement that has been opened, has a corresponding “End If” statement. This is in addition to Rule 1 above.

Example 1

If custage &amp;amp;lt; 60 Then
    roi = 6
    If strgen = "Female" And custage &amp;amp;gt; 57 Then roi = 8
    End If '********Line is explained below*********
Else
    roi = 8
End If

In this piece of code,

  • The inner “If” condition follows Rule 1 (i.e. code is placed in the same statement after “Then” keyword). Therefore, this statement is a standalone statement that does not require “End If”.
  • But since we have an “End If” statement , it will be considered to be the corresponding “End “ of the outer if statement (Line 1).
  • This leads to the “Else” keyword in the fifth line looking for its corresponding “If statement”. In turn, we end up with the error “Else without If” which is similar to “End if without block If”.
  • The solution to this problem is to remove the unnecessary “End if” in line 4 or place the code “roi=8” in the next line i.e between the IF… then and the End if statements.

Example 2

If apple = "sweet" Then
    If mango = "sweet" Then Debug.Print "Fruits are sweet"
    End If
End If

In this example,

  • Here since line 2 is already complete without “End if “, line 3 is automatically matched with the If statement of line number 1.
  • So, the “End If” in line 4 searches for its pair of “If statement” and leads to the compile error “End if without block If”.
  • The solution to this is to remove line 3 or place the “Debug.Print” statement in a separate line before the “End If” statement in line no 3.

Rule 3: Forgetting part of your deleted code

Ensure that there is no “End if” statement left behind without an “If” statement in your code. This might happen when you maintain code or change your logic after a long period of time.

For example, you might think that an “If – End if “ block of code might not be required in a certain place. And after you delete that “If block”, you may forget to delete its “End If” statement. This again causes the same compile error we keep seeing, “End if without block If”.

For Example:

If apple = "sweet" Then
    End If
End If

Imagine that you wanted to delete the inner If block in the above example. While doing so, you forgot to delete the “End If” statement. Then, you are sure to encounter the compile error “End If without block If”.

Here is a video that explains everything outlined above with sample code.  The code is explained and executed line by line, so you can completely understand what causes the error “End if without block If”.

Summary

Basically, when you look at the error statement, it is clear that it is thrown if there are any unnecessary ‘End If’ statements. The only solution is to trace the code and remove the erroneous statement after confirming that it does not affect the rest of the code in any way.

The other compile error “Else without If”, for which there is an example in Rule 2, is related to this error. It is thrown when there is an “Else <some code> End If” statement or just an “Else” statement without an “If <condition>  Then” statement. In general, for any error , it is wise and time saving to check the syntax first and then proceed with troubleshooting.

I am very new to VBA. I tried to calculate median for a vector. The following code keeps getting warning regarding «Block if without End if». I tried to change the place of «End IF», but it resulted in another warning «Block end if without if». Your input would be appreciated. Thanks.

Sub CalculateMedian()

    DoCmd.SetWarnings False

    Dim db As DAO.Database
    Dim onet As DAO.Recordset

    Dim Ocode As String
    Dim ag As DAO.Recordset
    Dim agMedian As Integer

    Set db = CurrentDb

    'select one variable in current database
    Set onet = db.OpenRecordset("SELECT DISTINCT ONetCode FROM Single WHERE LEN(ONetCode)>8")

    Do While Not onet.EOF

        'assigning value to a variable does not need a "SET"
        Ocode = onet.Fields("ONetCode")
        'any data meet the criterion--&Ocode& can vary
        Set ag = db.OpenRecordset("SELECT AG FROM Single WHERE ONetCode='" & Ocode & "' ORDER BY AG")

        'using .recordcount needs to use .movelast first
        ag.MoveLast
        ag.MoveFirst
        If ag.RecordCount Mod 2 = 1 Then
            agMedian = ((ag.RecordCount + 1) / 2)
            thecount = 0
            Do While Not ag.EOF
                thecount = thecount + 1
                If thecount = agMedian Then
                    'inset the result into a new table, and need to create a new table in advance
                    DoCmd.RunSQL ("INSERT INTO PCImedian(onetcode, agMedian) VALUES('" & Ocode & "'," & ag("AG") & ");")
                    Exit Do
        End If

       If ag.RecordCount Mod 2 = 0 Then
            agMedian = ag.RecordCount / 2
            thecount = 0
            Do While Not ag.EOF
                thecount = thecount + 1
                If thecount = agMedian Then
                    m1 = ag("AG")
                ElseIf thecount = agMedian + 1 Then
                    m2 = ag("AG")
                    DoCmd.RunSQL ("INSERT INTO PCImedian(onetcode, agMedian) VALUES('" & Ocode & "'," & ((m1 + m2) / 2) & ");")
                    Exit Do
        End If

    Loop

    DoCmd.SetWarnings True

End Sub

HansUp's user avatar

HansUp

95.4k11 gold badges75 silver badges135 bronze badges

asked Aug 16, 2013 at 16:53

lucyh's user avatar

1

The code was missing more than one End If. And there were 2 missing Loop statements as well.

When the code is complex enough that sorting out the block end statements becomes challenging, make a copy of the procedure and throw away basically everything other than the block control statements. That method leaves this from your current code.

    Do While Not onet.EOF
        If ag.RecordCount Mod 2 = 1 Then
            Do While Not ag.EOF
                If thecount = agMedian Then
        End If
        If ag.RecordCount Mod 2 = 0 Then
            Do While Not ag.EOF
                If thecount = agMedian Then
                ElseIf thecount = agMedian + 1 Then
        End If
    Loop

And here is my best guess for what you need instead. I appended comments to several of those statements because it helps me match them up properly.

    Do While Not onet.EOF
        If ag.RecordCount Mod 2 = 1 Then
            Do While Not ag.EOF
                If thecount = agMedian Then
                End If ' thecount
            Loop ' Not ag.EOF
        End If ' ag.RecordCount Mod 2 = 1
        If ag.RecordCount Mod 2 = 0 Then
            Do While Not ag.EOF
                If thecount = agMedian Then
                ElseIf thecount = agMedian + 1 Then
                End If ' thecount
            Loop ' Not ag.EOF
        End If ' ag.RecordCount Mod 2 = 0
    Loop ' Not onet.EOF

answered Aug 16, 2013 at 21:08

HansUp's user avatar

HansUpHansUp

95.4k11 gold badges75 silver badges135 bronze badges

0

it appears you’re missing an end if after the exit do in the first block of code. There should be 2 there, one to close out the last if statement, and one to close out the first block.

Sub CalculateMedian()

    DoCmd.SetWarnings False

    Dim db As DAO.Database
    Dim onet As DAO.Recordset

    Dim Ocode As String
    Dim ag As DAO.Recordset
    Dim agMedian As Integer

    Set db = CurrentDb

    'select one variable in current database
    Set onet = db.OpenRecordset("SELECT DISTINCT ONetCode FROM Single WHERE LEN(ONetCode)>8")

    Do While Not onet.EOF

        'assigning value to a variable does not need a "SET"
        Ocode = onet.Fields("ONetCode")
        'any data meet the criterion--&Ocode& can vary
        Set ag = db.OpenRecordset("SELECT AG FROM Single WHERE ONetCode='" & Ocode & "' ORDER BY AG")

        'using .recordcount needs to use .movelast first
        ag.MoveLast
        ag.MoveFirst
        If ag.RecordCount Mod 2 = 1 Then
            agMedian = ((ag.RecordCount + 1) / 2)
            thecount = 0
            Do While Not ag.EOF
                thecount = thecount + 1
                If thecount = agMedian Then
                    'inset the result into a new table, and need to create a new table in advance
                    DoCmd.RunSQL ("INSERT INTO PCImedian(onetcode, agMedian) VALUES('" & Ocode & "'," & ag("AG") & ");")


                   End If 'ends the If thecount = agMedian if statement -- will continue to iterate until EOF

                    Exit Do 'EOF hit.


        End If 'ends the If ag.RecordCount Mod 2 = 1 block

       If ag.RecordCount Mod 2 = 0 Then
            agMedian = ag.RecordCount / 2
            thecount = 0
            Do While Not ag.EOF
                thecount = thecount + 1
                If thecount = agMedian Then
                    m1 = ag("AG")
                ElseIf thecount = agMedian + 1 Then
                    m2 = ag("AG")
                    DoCmd.RunSQL ("INSERT INTO PCImedian(onetcode, agMedian) VALUES('" & Ocode & "'," & ((m1 + m2) / 2) & ");")
                    Exit Do
        End If 'thecount = agMedian if statement
        End If 'end ag.RecordCount Mod 2 = 0

    Loop

    DoCmd.SetWarnings True

End Sub

answered Aug 16, 2013 at 17:00

user2366842's user avatar

user2366842user2366842

1,23114 silver badges23 bronze badges

4

  • Remove From My Forums
  • Question

  • This is module files

    Option Explicit

    Sub Additem()
    Dim ItemRow As Long, AvailRow As Long
    With Sheet1
        If .Range(«B5»).Value = Empty Then Exit Sub
        On Error Resume Next
        .Shapes(«itempic»).Delete
        On Error GoTo 0
        ItemRow = .Range(«B5»).Value ‘item row
        AvailRow = .Range(«K999»).End(xlUp).Row + 1 ‘firs avail row
        .Range(«B6»).Value = AvailRow ‘Set Receipt Row
        .Range(«E3»).Value = Sheet2.Range(«B» & ItemRow).Value ‘Item Name
        .Range(«F6»).Value = Sheet2.Range(«D» & ItemRow).Value ‘Item Price
        .Range(«F8»).Value = 1 ‘Default Item Qty To 1

        ‘Add Item Detail to receipt
        .Range(«K» & AvailRow).Value = .Range(«E3»).Value ‘Item Name
        .Range(«L» & AvailRow).Value = .Range(«F8»).Value ‘Item Qty
        .Range(«M» & AvailRow).Value = .Range(«f6»).Value ‘Item Price
        .Range(«N» & AvailRow).Value = «=L» & AvailRow & «*M» & AvailRow ‘Total Price formula

        ‘On Error Resume Next
        If Dir(Sheet2.Range(«E» & ItemRow).Value, vbDirectory) <> «» Then
            With .Pictures.Insert(Sheet2.Range(«E» & ItemRow).Value)
             With .ShapeRange
              .LockAspectRatio = msoTrue
              .Height = 45
              .Name = «ItemPic»
            End With
           End With
           With .Shapes(«ItemPic»)
           .Left = Sheet1.Range(«D6»).Left
           .Top = Sheet1.Range(«D6»).Top
           .Visible = msoCTrue
          End With
        End If
        ‘On Error Goto 0
        .Range(«E10:F10»).ClearContents ‘Clear Iteam Iteam
        .Range(«E10»).Select
        End With
        End Sub

    ………………………………………………………………………………………

    This is sheet 1 code

    Private Sub Worksheet_Change(ByVal Target As Range)
    ‘on change of item, if row found and add to receipt
    If Not Intersect(Target, Range(«E10»)) Is Nothing And Range(«E10»).Value <> Empty Then Additem

    End Sub

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ‘On Selection of Receipt Item, load Item details
    If Not Intersect(Target, Range(«K10:N9999»)) Is Nothing And Range(«K» & Target.Row).Value <> Empty Then Additem
        Range(«B6»).Value = Target.Row ‘Selected Row
        Range(«B4»).Value = True
        Range(«E3»).Value = Range(«K» & Target.Row).Value ‘Item Name
        Range(«F8»).Value = Range(«L» & Target.Row).Value ‘Item Qty
        Range(«F6»).Value = Range(«M» & Target.Row).Value ‘Item Price
        Range(«B4»).Value = False
    End If

    End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
        
Sub Algdevis()
 
Worksheets("devis").Select
 
Dim codeclient As Integer
Dim nom As String
Dim rue As String
Dim ville As String
Dim codepostal As String
Dim pays As String
Dim tel As Long
Dim email As String
Dim ndevis As Integer
Dim distance As Single
Dim terrain As Single
Dim paymentMode As String
Dim reference As String
Dim quantCom As Integer
reponse = 6
cpt = 1
i = 1
s = 2
t = 3
w = 3
Do While reponse = 6
    
    ligneNumero = cpt + 25
    
    If cpt = 1 Then
          
        codeclient = InputBox("Entrez le code du client :")
           
        Do While i <= 20
           
            If Worksheets("clients").Cells(i, 1) = codeclient Then
                Worksheets("devis").Cells(5, 4) = codeclient
               
                Do While s <= 8
                    Worksheets("devis").Cells(4 + s, 4).Value = Worksheets("clients").Cells(i, s).Value
                    s = s + 1
                Loop
         
            Exit Do
            
            End If
        i = i + 1
        Loop
    
    End If
    
    Do While reponseType <> "achat" Or reponseType <> "service"
        reponseType = InputBox("Il s'agit d'un achat ou du service?")
    Loop
    
    If reponseType = "achat" Then
        tva = 19.6
        tauxDeRemise = 0
        reference = InputBox("Entrez le reference :")
        Worksheets("devis").Cells(ligneNumero, 1).Value = reference
        
        Do While t < 200
           
            If Worksheets("plantes et arbres").Cells(t, 1).Value = reference Then
                Worksheets("devis").Cells(ligneNumero, 2).Value = Worksheets("plantes et arbres").Cells(t, 2).Value
                Worksheets("devis").Cells(ligneNumero, 4).Value = Worksheets("plantes et arbres").Cells(t, 3).Value
                Exit Do
            End If
           
        t = t + 1
        Loop
        
        quantite = InputBox("Entrez la quantite d'achat:")
        Worksheets("devis").Cells(ligneNumero, 3).Value = quantite
        Worksheets("devis").Cells(20, 2).Value = 19.6
        Worksheets("devis").Cells(ligneNumero, 1).Value = reference
        montant = quantite * Worksheets("devis").Cells(ligneNumero, 4).Value
        Worksheets("devis").Cells(ligneNumero, 5).Value = montant
        Worksheets("devis").Cells(19, 2).Value = montant
        Worksheets("devis").Cells(21, 2).Value = montant * (tva / 100)
        
    ElseIf reponseType = "service" Then
        quantite = 1
        Worksheets("devis").Cells(ligneNumero, 3).Value = quantite
        serviceJardin = InputBox("Il s'agit de creation du jardin ou de entretien?")
        
        If serviceJardin = "creation" Then
            tva = 19.6
            terrain = InputBox("Entrez la surface du terrain :")
            Worksheets("devis").Cells(16, 2) = terrain
            
                If terrain < 200 Then tauxDeRemise = 1
                ElseIf terrain > 200 And terrain < 600 Then tauxDeRemise = 2.5
                ElseIf terrain > 600 And terrain < 1000 Then tauxDeRemise = 3
                ElseIf terrain > 1000 And terrain <= 10000 Then tauxDeRemise = 5
                ElseIf terrain > 10000 Then tauxDeRemise = 10
                End If
                Worksheets("devis").Cells(18, 2).Value = tauxDeRemise
        ElseIf serviceJardin = "entretien" Then
            tva = 5.5
            Worksheets("devis").Cells(16, 2) = 0
        End If
        
        reference = InputBox("Entrez le reference :")
        
        Do While w <= 200
           
            If Worksheets("Prestations").Cells(t, 1).Value = reference Then
                Worksheets("devis").Cells(ligneNumero, 2).Value = Worksheets("Prestations").Cells(w, 2).Value
                Worksheets("devis").Cells(ligneNumero, 4).Value = Worksheets("Prestations").Cells(w, 3).Value
                Exit Do
            End If
        w = w + 1
               
        Loop
        
        Worksheets("devis").Cells(ligneNumero, 1).Value = reference
        montant = Worksheets("devis").Cells(ligneNumero, 3).Value * Worksheets("devis").Cells(ligneNumero, 4).Value
        Worksheets("devis").Cells(ligneNumero, 5).Value = montant
        Worksheets("devis").Cells(19, 2).Value = montant
        Worksheets("devis").Cells(20, 2).Value = montant * (1 - (Worksheets("devis").Cells(18, 2).Value / 100))
        Worksheets("devis").Cells(21, 2).Value = (montant - montant * (tauxDeRemise / 100)) * (tva / 100)
        
    End If 'при выдаче ошибки выделяет эту строку
    
    
    ndevis = InputBox("Entrez le numero du devis :")
    Worksheets("devis").Cells(14, 2) = ndevis
           
    distance = InputBox("Entrez la distance :")
    
    If distance <= 50 Then fraisDeTransport = Worksheets("Transport").Cells(3, 2).Value
    ElseIf distance <= 200 And distance > 50 Then fraisDeTransport = Worksheets("Transport").Cells(4, 2).Value
    ElseIf distance > 200 Then fraisDeTransport = Worksheets("Transport").Cells(5, 2).Value
    End If  
    fraisDeTransport = fraisDeTransport + fraisDeTransport * 0.055
    Worksheets("devis").Cells(15, 2).Value = distance
    Worksheets("devis").Cells(22, 2) = fraisDeTransport
    paymentMode = InputBox("Entrez le mode de payement :")
    Worksheets("devis").Cells(17, 2) = paymentMode
    Total = Worksheets("devis").Cells(20, 2).Value + Worksheets("devis").Cells(20, 2).Value * (tva / 100) + fraisDeTransport
    Worksheets("devis").Cells(23, 2) = Worksheets("devis").Cells(23, 2) + Total
    reponse = MsgBox("Voulez-vous acheter encore une plante?", vbYesNo)
    
    If reponse = vbYes Then
        cpt = cpt + 1
        reponseType = ""
    End If
    
Loop
                      
End Sub

I have a combobox in Word that is supposed to populate the termShorthand text field based on the selection from the termWritten array. I am receiving the Block If without End If compile error even though I have it after my If statements.

Private Sub termWritten_DropButtonClick()
    termWritten.List = Array("first", "second", "third", "final")
End Sub

Private Sub termWritten_Change()
    If termWritten.Value = "first" Then
        termShorthand.Value = "three (3)"
    Else
        If termWritten.Value = "second" Then
            termShorthand.Value = "two (2)"
        Else
            If termWritten.Value = "third" Then
                termShorthand.Value = "one (1)"
            Else
                If termWritten.Value = "final" Then
                    termShorthand.Value = "no"
                End If
End Sub

I say Reinstate Monica's user avatar

asked May 7, 2019 at 15:18

Kyle Underhill's user avatar

Kyle UnderhillKyle Underhill

1151 gold badge2 silver badges10 bronze badges

You need an End If statement for each If statement, like this:

Private Sub termWritten_Change()
    If termWritten.Value = "first" Then
        termShorthand.Value = "three (3)"
    Else
        If termWritten.Value = "second" Then
            termShorthand.Value = "two (2)"
        Else
            If termWritten.Value = "third" Then
                termShorthand.Value = "one (1)"
            Else
                If termWritten.Value = "final" Then
                    termShorthand.Value = "no"
                End If 'final
            End If 'third
        End If 'second
    End If 'first
End Sub

You can learn more about the If…Then…Else statement on Microsoft Docs.

answered May 7, 2019 at 15:27

I say Reinstate Monica's user avatar

@twisty impersonator’s correct regarding the syntax for if/then/else, but your code would be simpler to follow and update if you used Select Case instead:

Private Sub termWritten_Change()

Select Case termWritten.Value
   Case Is = "first
      termShorthand.Value = "three (3)"
   Case Is = "second"
      termShorthand.Value = "two (2)"
   ' and so on, adding another Case Is = "xyz" for each value
   ' you want to test for.  At the end, it's usually a good idea to
   ' include
   Case Else
     ' This runs if no other conditions are met
     ' Use it to set an error code, supply a default value, etc.
End Select

End Sub

And following twisty’s example, I’m adding a link to MS’ documentation for Select Case:

https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/select-case-statement

answered May 7, 2019 at 15:54

Steve Rindsberg's user avatar

Steve RindsbergSteve Rindsberg

5,4711 gold badge15 silver badges17 bronze badges

While Select Case is probably better it’s worth mentioning that you could have used ElseIf and then only one End If would be required

Private Sub termWritten_DropButtonClick()

   termWritten.List = Array("first", "second", "third", "final")

End Sub

Private Sub termWritten_Change()

   If termWritten.Value = "first" Then

       termShorthand.Value = "three (3)"

   ElseIf termWritten.Value = "second" Then

       termShorthand.Value = "two (2)"

   ElseIf termWritten.Value = "third" Then

       termShorthand.Value = "one (1)"

   ElseIf termWritten.Value = "final" Then

       termShorthand.Value = "no"

   End If

End Sub

answered Jun 5, 2019 at 21:26

Steven Martin's user avatar

Hi Guys — not sure i have put this in the correct forum but we shall give it a go

I am working on a master excel spreadsheet that identifies its own file path, searches for a folder called EO_121DATA in that file path and then takes a specific sheet (121 Data) from each workbook in the folder and create a copy of it in the master, labelling
it the name of person which is in cell B2.

It will be updated every month and it needs to remove sheets when files are deleted and add sheets when new ones are created.

I think I have written something that will work, and once I know the script is fine I will create a button to initiate it. 

When I run the script I get the error: Compile Error Block If without End If and it highlights the End Sub command line at the bottom.

Here’s what I’ve written so far, when its in use it will be running on Excel 2010, though I am currently editing it at home on 2007.

Sub Import_Team()

Dim wsSrc As Worksheet                                              ' Source Sheet
Dim wbSrc As Workbook                                               ' Source Workbook
Dim wbDst As Workbook                                               ' Destination Workbook
Dim shDst As Worksheet                                              ' Destination Worksheet
Dim useWS As Boolean                                                ' Used to indicate Start and End Sheets

Dim ManagerPath As String                                           ' Find manager workbook file path
Dim OfficerPath As String                                           ' Find folder EO_121DATA in team folder for the manager
Dim srcFilename As String                                           ' Finds workbooks in EO_121Data

                                                                    'define the file paths
ManagerPath = Application.ThisWorkbook.Path                         ' Finds the filepath of the workbook running the macro
OfficerPath = Dir(ManagerPath & "EO_121Data")                      ' Adds the EO_121DATA to the above filepath, as long as the manager file is kept in the folder that contains EO_121DATA it will find the relevent files
srcFilename = Dir(OfficerPath & "*.xls*", vbNormal)                ' Finds any excel workbooks in the EO_121DATA file, the asterisk are wildcards so any excel format and sheet name will be found

useWS = False

If OfficerPath = "" Then
MsgBox "There is currently no folder containing Enquiry Officer documents. Please create a file called EO_121DATA in the same file as your manager sheet and copy your teams files into it.", vbOKOnly, "No Destination File"
Exit Sub                                                            ' If there is no EO_121DATA folder the manager will be told and the sub will stop.

Do Until OfficerPath <> ""

If srcFilename = "" Then
MsgBox "There are currently no team data sheets saved in the folder EO_121DATA.", vbOKOnly, "No Data Available"
Exit Sub                                                            ' If there are no files in EO_121DATA it will stop the macro and do nothing, a message box advising no files were found in the specified folder will show.

Do Until srcFilename <> ""
                                                                    ' Stop the screen from showing each workbook being opened checked and closed
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

For Each shDst In ActiveWorkbook.Sheets                             ' Clears old worksheets in the book

If shDst.Name = "End" Then
useWS = False                                                       ' Turns off sheet processing
End If

If shDst.Name = "Start" Then
useWS = True                                                        ' Turns on sheet processing
End If

If useWS = True And shDst.Name <> "Start" Then
shDst.Delete                                                        ' Deletes old sheets ready to be updated, run the macro each month as officer sheets are updated
End If

Next shDst

                                                                    ' Loop through the source files in EO_121DATA
While srcFilename <> ""
TabName = Replace(srcFilename, "Tracker.xlsm", "")                  ' Creates a tab
Worksheets.Add Before:=Sheets("End")
ActiveSheet.Name = TabName
Set shDst = ActiveSheet

                                                                    ' Copy from source workbook to destination workbook

Set wbSrc = Workbooks.Open(srcFilename)
Set shSrc = wbSrc.Sheets("121 Data")
shDst.Name = shSrc.Range("$B$2")
shSrc.Cells.Copy
shDst.Range("A1").PasteSpecial xlPasteValues
shDst.Columns.AutoFit
wbSrc.Close savechanges:=False

                                                                    ' Get the next file
srcFilename = Dir()

Wend
Loop

Sheets("Team Average").Select
                                                                    ' re-enables the screen so it shows files being opened and closed
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub


Thanks in advance for your help.

  • Moved by

    Friday, June 16, 2017 8:25 AM
    Moved from VB.NET

Понравилась статья? Поделить с друзьями:
  • Block error rate
  • Block error amnf victoria что это
  • Block error abrt что это значит
  • Block error abrt victoria что это
  • Block 0 tftpd ошибка