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.
- A simple If Block
- An If – Else block
- An Else-If block
- 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;lt;condition&amp;gt; Then &amp;lt;code&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;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;lt; 60 Then roi = 6 If strgen = "Female" And custage &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
95.4k11 gold badges75 silver badges135 bronze badges
asked Aug 16, 2013 at 16:53
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
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
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 AdditemEnd 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 IfEnd 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
asked May 7, 2019 at 15:18
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
@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 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
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