End with without with ошибка

This can actually be caused by not having other control structures closed. The compiler can get confused and report this as a missing End With. Here are items to look for:

  • If/End If
  • Select/End Select
  • For/Next
  • Do/Loop
  • While/Wend

And of course,

  • With/End With

If you check to be sure each of these is closed properly, You’ll find the issue in your code.

As to why?

You can think of each of these structures like Russian nesting dolls. You have to close each one before putting in into a larger doll. Likewise, you have to open each doll in order to get the next smaller one.

Take this mental exercise a bit further for a moment. Try to imagine how you would manage to do otherwise? In other words, how would you place a doll inside the next larger doll without first closing it? You could just put in the bases and leave all the heads till the end, but that’s not how Russian nesting dolls work. You can’t put the heads on out of order.

That is what you are asking the compiler to do without closing each item in turn and a compiler can only take explicit instructions, so it can not determine your intent.

For a visual, consider this structure. It’s orderly and makes immediate logical sense. What makes sense is the nesting. Each structure is nested inside another structure.

--------+
--+     |
  |     |
--+     |
------+ |
----+ | |
    | | |
----+ | |
------+ |
--------+

Compare to this:

------+
--------+
--+   | |
--|-+ | |
--|-------+
  | | | | |
--+ | | | |
    | | | |
----|-+ | |
----+   | |
--------+ |
----------+

Try putting these nesting dolls back together by following these Steps:

  1. Take the smallest body
  2. Close it with one or more random head
  3. Put this inside of the next larger body
  4. Repeat

Ironman’s head on Nick Fury’s body and then put that into Captain America with the Hulk’s head and put all of that into the Thor’s body with Nick Fury’s head. And then put that into Hulk’s body. Good luck!

There’s only one step above that makes this process NOT work.

enter image description here

Источник

Permalink

Cannot retrieve contributors at this time

title keywords f1_keywords ms.prod ms.assetid ms.date ms.localizationpriority

End With without With

vblr6.chm1040134

vblr6.chm1040134

office

b91cf47b-85f3-0429-a9ce-7e705ff52a0e

06/08/2017

medium

End With must be matched with a preceding With. This error has the following cause and solution:

  • You used an End With statement without a corresponding With statement. Check other control structures within the With…End With structure and verify that they are correctly matched. For example, an If without a matching End If inside the With…End With structure can cause this error.

For additional information, select the item in question and press F1 (in Windows) or HELP (on the Macintosh).

[!includeSupport and feedback]

Источник

Noob_IT

0 / 0 / 0

Регистрация: 04.07.2015

Сообщений: 34

1

22.07.2016, 16:15. Показов 3272. Ответов 5

Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам

Добрый вечер, подскажите пожалуйста почему пожалуйста выдает ошибку? with закрывается end with, но сообщение что with не закрыт.. Как исправить ошибку?
З.Ы Это процедура кнопки входа на форме авторизации при запуске книги.
Открывается форма входа, в combobox выбирается пользователь, в textbox вводится пароль, по нажатию кнопки войти
выбранный в combobox пользователь(ФИО) ищется на листе users в столбце A, а пароль в столбце B. Каждому пользователю виден только его лист(название листа соответствует выбранному в combobox пользователю)

Помогите пожалуйста

Visual Basic 
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

Private Sub cmndbOK_Click()
    Dim rFndRng As Range
    Dim oSheet As Worksheet
    Dim sUserRange As String, sUserSheet As String, sSheets, li As Long
 
    With ThisWorkbook.Sheets("Users")
        If Combobox1 <> "" Then
            Set rFndRng = .Columns(1).Find(what:=Combobox1, lookat:=xlWhole)
            If Not rFndRng Is Nothing Then
                sUserSheet = .Cells(rFndRng.Row, 3)
                sSheets = Split(sUserSheet, ";")
                End If
                If Me.TextBox1 = CStr(.Cells(rFndRng.Row, 2)) Then
                    For Each oSheet In ThisWorkbook.Sheets
                        If oSheet.Name <> Combobox1 Then oSheet.Visible = 2
                        End If
                    Next
                    For Each oSheet In ThisWorkbook.Sheets
                        If oSheet.Name <> "Users" Then
                            For li = 0 To UBound(sSheets)
                                If oSheet.Name = sSheets(li) Then
                                    Sheets(sSheets(li)).Visible = -1
                                    End If
                            Next li
        End If
    End With
End Sub

Миниатюры

Ошибка End With without with
 



0

6878 / 2810 / 534

Регистрация: 19.10.2012

Сообщений: 8,573

22.07.2016, 16:16

2

Между 24 и 25 не хватает next



0

Noob_IT

0 / 0 / 0

Регистрация: 04.07.2015

Сообщений: 34

22.07.2016, 16:25

 [ТС]

3

Hugo121, теперь другая ошибка End if without block if в 16 строке

Visual Basic 
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

Private Sub cmndbOK_Click()
    Dim rFndRng As Range
    Dim oSheet As Worksheet
    Dim sUserRange As String, sUserSheet As String, sSheets, li As Long
 
    With ThisWorkbook.Sheets("Users")
        If Combobox1 <> "" Then
            Set rFndRng = .Columns(1).Find(what:=Combobox1, lookat:=xlWhole)
            If Not rFndRng Is Nothing Then
                sUserSheet = .Cells(rFndRng.Row, 3)
                sSheets = Split(sUserSheet, ";")
                End If
                If Me.TextBox1 = CStr(.Cells(rFndRng.Row, 2)) Then
                    For Each oSheet In ThisWorkbook.Sheets
                        If oSheet.Name <> Combobox1 Then oSheet.Visible = 2
                        End If
                    Next
                    For Each oSheet In ThisWorkbook.Sheets
                        If oSheet.Name <> "Users" Then
                            For li = 0 To UBound(sSheets)
                                If oSheet.Name = sSheets(li) Then
                                    Sheets(sSheets(li)).Visible = -1
                                    End If
                            Next li
                      Next
        End If
    End With
End Sub



0

6878 / 2810 / 534

Регистрация: 19.10.2012

Сообщений: 8,573

22.07.2016, 16:27

4

Так уберите 16-ю.
Или разбейте 15-ю.
Или Вам в «первый класс», учить синтаксис.



0

655 / 247 / 89

Регистрация: 28.10.2015

Сообщений: 524

22.07.2016, 20:57

5

Внимательно отнеситесь к каждой процедуре.
У каждого If должен быть свой End if рано или поздно.
Исключением являются однострочные простые Ifы, а также Iif’ы
У каждого For… должен быть свой Next (причем вовсе необязательно писать «next li», достаточно просто «next». При достаточной внимательности это значительно упростит дело)

И кроме всего сказанного выше, ради себя и пользователей форума, установите программу Smart Indent. И используйте, она поможет расставить отступы, смысл которых — упрощение читаемости вашего кода. Самому легче будет находить, где теперь не хватает «Next», а где «end if»



0

0 / 0 / 0

Регистрация: 04.07.2015

Сообщений: 34

24.07.2016, 16:41

 [ТС]

6

Святой НякаЛайк, эту ошибку устранил, теперь дальше не получается. Помогите пожалуйста, вот ссылка на тему: Method ‘Visible’ of object ‘_worksheet’ failed



0

IT_Exp

Эксперт

87844 / 49110 / 22898

Регистрация: 17.06.2006

Сообщений: 92,604

 24.07.2016, 16:41

Помогаю со студенческими работами здесь

Ошибка $end
Привет всем! Сделал простую форму регистрации а она не работает перехожу на страницу регистрации…

ошибка с END в коде
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,…

Ошибка в begin и end
Ошибка в begin и end.Что убрать?
procedure TForm1.Button1Click(Sender: TObject);
var…

Ошибка. Record.end
Ошибка 39 и 40 строки. Пишет, что types of actual and formal var parameters must be identical….

Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:

6

Источник

Problem Description:

I have a code that contains nested if statements, I am getting either an «End With without With» or an «End If without If» errors. I need help what I should change in my code. Here is the logic I need to create:

I have two sheets, one is called «OUTGOING ACH» and the other is called «OUTGOING WIRE». I am trying to check their contents, whatever doesn’t have content should be deleted and the other one should be reformatted and called «OUTGOING». If both have contents, reformat them, combine them in one of the sheets, call it «OUTGOING», and delete the other one.

Here is a simple version of my code annotations:

'If OUTGOING ACH is empty Then
    'Delete OUTGOING ACH
    'If OUTGOING WIRE is empty
        'Delete OUTGOING WIRE
    'Else If OUTGOING WIRE isn't empty
        'Reformat OUTGOING WIRE
        'Rename OUTGOING WIRE to "OUTGOING"
    'End If
'Else If OUTGOING ACH isn't empty Then
    'Reformat OUTGOING ACH
    'Rename OUTGOING ACH to "OUTGOING"
    'If OUTGOING WIRE is empty
        'Delete OUTGOING WIRE
    'Else If OUTGOING WIRE isn't empty
        'Reformat OUTGOING WIRE
        'Copy OUTGOING WIRE to OUTGOING (formerly "OUTGOING ACH")
        'Delete OUTGOING WIRE
    'End If
'End If

I previously defined Header and Bottom as the header row and the last row with data. Here is the full code:

    With NewBatch.Sheets("OUTGOING ACH")
        Bottom = .Cells(.Rows.Count, 1).End(xlUp).Row
        Header = Application.Match("Account*", .Range("A:A"), 0)

        If Bottom = Header Then                                         'If Outgoing ACH is empty   >> If 1
            Application.DisplayAlerts = False                               'Delete it and go to Outgoing wire
            NewBatch.Sheets("OUTGOING ACH").Delete
            Application.DisplayAlerts = True
    
    End With
    
    
        
            With NewBatch.Sheets("OUTGOING WIRE")
                Bottom = .Cells(.Rows.Count, 1).End(xlUp).Row
                Header = Application.Match("Account*", .Range("A:A"), 0)
                
            If Bottom = Header Then                                     'If Outgoing wire is also empty   >> If 2
                Application.DisplayAlerts = False                           'Delete it also
                NewBatch.Sheets("OUTGOING WIRE").Delete
                Application.DisplayAlerts = True
        
            ElseIf Bottom <> Header Then                                                            'But if Outgoing wire is not empty   >> Else 2
                .Activate                                               'Reformat OUTGOING WIRE
                .Columns("B:D").Delete Shift:=xlToLeft
                .Columns("C:Z").Delete Shift:=xlToLeft
                .Columns("A:A").Insert Shift:=xlToRight
                .Columns("A:A").Insert Shift:=xlToRight
                .Columns("A:A").Insert Shift:=xlToRight
                .Columns("E:E").Cut
                .Columns("D:D").Insert Shift:=xlToRight
                .Range("A" & Header).Select
                Selection.FormulaR1C1 = "Payment Account (Kyriba Account Code)"
                ActiveCell.Offset(0, 1).Select
                Selection.FormulaR1C1 = "Transaction Code (CCD, PPD, FEDW, INTW, or DDBT)"
                ActiveCell.Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = "Transaction Date (mm/dd/yyyy)"
                ActiveCell.Offset(0, 2).Select
                ActiveCell.FormulaR1C1 = "Third Party"
                ActiveCell.Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = "CCY"
                ActiveCell.Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = "Batch ID"
                .Range(("E" & Header + 1) & ":" & "E" & Bottom).Copy
                .Range(("A" & Header + 1) & ":" & "A" & Bottom).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                .Range(("B" & Header + 1) & ":" & "B" & Bottom).Value = "FEDW"
                .Range(("C" & Header + 1) & ":" & "C" & Bottom).Value = Date
                .Range(("F" & Header + 1) & ":" & "F" & Bottom).Value = "USD"
                .Range(("G" & Header + 1) & ":" & "G" & Bottom).Value = Format(Now, "mmddyyyyhmmss")
                .Range(("G" & Header + 1) & ":" & "G" & Bottom).NumberFormat = "#"
                .Range("H" & Header).Value = "-1"
                .Range("H" & Header).Copy
                .Range(("D" & Header + 1) & ":" & "D" & Bottom).PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
                SkipBlanks:=False, Transpose:=False
                .Range("H" & Header).ClearContents
                .Rows("1:" & Header - 1).Delete Shift:=xlUp
                .Cells.Select
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 11
                        .Strikethrough = False
                        .Superscript = False
                        .Subscript = False
                        .OutlineFont = False
                        .Shadow = False
                        .Underline = xlUnderlineStyleNone
                        .ThemeColor = xlThemeColorLight1
                        .TintAndShade = 0
                        .ThemeFont = xlThemeFontMinor
                        .Bold = False
                    End With
                    With Selection.Borders
                        .LineStyle = xlNone
                    End With
                    With Selection
                        .WrapText = False
                        .EntireColumn.AutoFit
                        .EntireRow.AutoFit
                    End With
                .Columns("D:D").NumberFormat = "0.00"
                .Range("A1").Select
                .Name = ("OUTGOING")
            End If                                                      '>> End of If 2 (ACH is empty and whether or not Wire is empty)
            End With
                                                                    'Now, if Outgoing ACH wasn't empty >> Else If 1
                                                                        'First reformat Outgoing ACH
            With NewBatch.Sheets("OUTGOING ACH")
                Bottom = .Cells(.Rows.Count, 1).End(xlUp).Row
                Header = Application.Match("Account*", .Range("A:A"), 0)
        
        ElseIf Bottom <> Header Then
                .Activate
                .Columns("B:D").Delete Shift:=xlToLeft
                .Columns("C:Z").Delete Shift:=xlToLeft
                .Columns("A:A").Insert Shift:=xlToRight
                .Columns("A:A").Insert Shift:=xlToRight
                .Columns("A:A").Insert Shift:=xlToRight
                .Columns("E:E").Cut
                .Columns("D:D").Insert Shift:=xlToRight
                .Range("A" & Header).Select
                Selection.FormulaR1C1 = "Payment Account (Kyriba Account Code)"
                ActiveCell.Offset(0, 1).Select
                Selection.FormulaR1C1 = "Transaction Code (CCD, PPD, FEDW, INTW, or DDBT)"
                ActiveCell.Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = "Transaction Date (mm/dd/yyyy)"
                ActiveCell.Offset(0, 2).Select
                ActiveCell.FormulaR1C1 = "Third Party"
                ActiveCell.Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = "CCY"
                ActiveCell.Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = "Batch ID"
                .Range(("E" & Header + 1) & ":" & "E" & Bottom).Copy
                .Range(("A" & Header + 1) & ":" & "A" & Bottom).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                .Range(("B" & Header + 1) & ":" & "B" & Bottom).Value = "CCD"
                .Range(("C" & Header + 1) & ":" & "C" & Bottom).Value = Date
                .Range(("F" & Header + 1) & ":" & "F" & Bottom).Value = "USD"
                .Range(("G" & Header + 1) & ":" & "G" & Bottom).Value = Format(Now, "mmddyyyyhmmss")
                .Range(("G" & Header + 1) & ":" & "G" & Bottom).NumberFormat = "#"
                .Range("H" & Header).Value = "-1"
                .Range("H" & Header).Copy
                .Range(("D" & Header + 1) & ":" & "D" & Bottom).PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
                SkipBlanks:=False, Transpose:=False
                .Range("H" & Header).ClearContents
                .Rows("1:" & Header - 1).Delete Shift:=xlUp
                .Cells.Select
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 11
                        .Strikethrough = False
                        .Superscript = False
                        .Subscript = False
                        .OutlineFont = False
                        .Shadow = False
                        .Underline = xlUnderlineStyleNone
                        .ThemeColor = xlThemeColorLight1
                        .TintAndShade = 0
                        .ThemeFont = xlThemeFontMinor
                        .Bold = False
                    End With
                    With Selection.Borders
                        .LineStyle = xlNone
                    End With
                    With Selection
                        .WrapText = False
                        .EntireColumn.AutoFit
                        .EntireRow.AutoFit
                    End With
                .Columns("D:D").NumberFormat = "0.00"
                .Range("A1").Select
                .Name = ("OUTGOING")
            End With
            
        With NewBatch.Sheets("OUTGOING WIRE")                           'Then check if Ougoing Wire is empty
        
            Bottom = .Cells(.Rows.Count, 1).End(xlUp).Row
            Header = Application.Match("Account*", .Range("A:A"), 0)
                
                If Bottom = Header Then                                 'If Outgoing Wire is empty   >> If 3
                    Application.DisplayAlerts = False                       'Delete Outgoing Wire
                    NewBatch.Sheets("OUTGOING WIRE").Delete
                    Application.DisplayAlerts = True
        
                ElseIf Bottom <> Header Then                                                        'If Outgoing Wire isn't empty (both aren't empty)   >> Else if 3
                .Activate                                               'Reformat outgoing wire
                .Columns("B:D").Delete Shift:=xlToLeft
                .Columns("C:Z").Delete Shift:=xlToLeft
                .Columns("A:A").Insert Shift:=xlToRight
                .Columns("A:A").Insert Shift:=xlToRight
                .Columns("A:A").Insert Shift:=xlToRight
                .Columns("E:E").Cut
                .Columns("D:D").Insert Shift:=xlToRight
                .Range("A" & Header).Select
                .Selection.FormulaR1C1 = "Payment Account (Kyriba Account Code)"
                ActiveCell.Offset(0, 1).Select
                Selection.FormulaR1C1 = "Transaction Code (CCD, PPD, FEDW, INTW, or DDBT)"
                ActiveCell.Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = "Transaction Date (mm/dd/yyyy)"
                ActiveCell.Offset(0, 2).Select
                ActiveCell.FormulaR1C1 = "Third Party"
                ActiveCell.Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = "CCY"
                ActiveCell.Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = "Batch ID"
                .Range(("E" & Header + 1) & ":" & "E" & Bottom).Copy
                .Range(("A" & Header + 1) & ":" & "A" & Bottom).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                .Range(("B" & Header + 1) & ":" & "B" & Bottom).Value = "FEDW"
                .Range(("C" & Header + 1) & ":" & "C" & Bottom).Value = Date
                .Range(("F" & Header + 1) & ":" & "F" & Bottom).Value = "USD"
                .Range(("G" & Header + 1) & ":" & "G" & Bottom).Value = Format(Now, "mmddyyyyhmmss")
                .Range(("G" & Header + 1) & ":" & "G" & Bottom).NumberFormat = "#"
                .Range("H" & Header).Value = "-1"
                .Range("H" & Header).Copy
                .Range(("D" & Header + 1) & ":" & "D" & Bottom).PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
                SkipBlanks:=False, Transpose:=False
                .Range("H" & Header).ClearContents
                .Rows("1:" & Header - 1).Delete Shift:=xlUp
                .Cells.Select
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 11
                        .Strikethrough = False
                        .Superscript = False
                        .Subscript = False
                        .OutlineFont = False
                        .Shadow = False
                        .Underline = xlUnderlineStyleNone
                        .ThemeColor = xlThemeColorLight1
                        .TintAndShade = 0
                        .ThemeFont = xlThemeFontMinor
                        .Bold = False
                    End With
                    With Selection.Borders
                        .LineStyle = xlNone
                    End With
                    With Selection.Borders
                        .WrapText = False
                        .EntireColumn.AutoFit
                        .EntireRow.AutoFit
                    End With
            .Columns("D:D").NumberFormat = "0.00"
            Bottom = WorksheetFunction.Match((Cells(Rows.Count, 1).End(xlUp)), Range("A:A"), 0)
            .Rows("2" & ":" & Bottom).Copy
        End With
        
            With NewBatch.Sheets("OUTGOING")
                Bottom = WorksheetFunction.Match((Cells(Rows.Count, 1).End(xlUp)), Range("A:A"), 0)
                .Rows(Bottom + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                .Range("A1").Select
            End With
            Application.DisplayAlerts = False
            Sheets("OUTGOING WIRE").Delete
            Application.DisplayAlerts = True

                End If                                                  'End of If 3 (ACH isn't empty and whether or not wire is empty)
        End If                                                          'End of If 1 (The whole test for ACH and Outgoing Wire)

I tried to reposition End If and End With but that didn’t work.

Thanks!

Solution – 1

As others have pointed out there are many errors in your code, but to name a few:

With NewBatch.Sheets("OUTGOING ACH")
    Bottom = .Cells(.Rows.Count, 1).End(xlUp).Row
    Header = Application.Match("Account*", .Range("A:A"), 0)

    If Bottom = Header Then                                         'If Outgoing ACH is empty   >> If 1
        Application.DisplayAlerts = False                               'Delete it and go to Outgoing wire
        NewBatch.Sheets("OUTGOING ACH").Delete
        Application.DisplayAlerts = True
    End If '<= this is the closing `End If` for 'If Bottom = Header Then'           
End With

Further, the section staring with:

With NewBatch.Sheets("OUTGOING ACH")
   Bottom = .Cells(.Rows.Count, 1).End(xlUp).Row
   Header = Application.Match("Account*", .Range("A:A"), 0)
   
   If (something = true) Then '<= Missing `If` initialization in your code
       'do something
   ElseIf Bottom <> Header Then

       'whole bunch of code ending with last few lines as per below

       .Columns("D:D").NumberFormat = "0.00"
       .Range("A1").Select
       .Name = ("OUTGOING")
   End If '<= Missing `End If` statement to close the `If (something = true) Then' statement
End With

Subsequently section starting with:

With NewBatch.Sheets("OUTGOING WIRE")                           'Then check if Ougoing Wire is empty
        
    Bottom = .Cells(.Rows.Count, 1).End(xlUp).Row
    Header = Application.Match("Account*", .Range("A:A"), 0)
                
    If Bottom = Header Then 'If Outgoing Wire is empty   >> If 3
        Application.DisplayAlerts = False 'Delete Outgoing Wire
        NewBatch.Sheets("OUTGOING WIRE").Delete
        Application.DisplayAlerts = True
        
    ElseIf Bottom <> Header Then

        'whole bunch of code ending with last few lines as per below

        .Columns("D:D").NumberFormat = "0.00"
        Bottom = WorksheetFunction.Match((Cells(Rows.Count, 1).End(xlUp)), Range("A:A"), 0)
        .Rows("2" & ":" & Bottom).Copy
    End If '<= Missing 'End If' to close the 'If Bottom = Header Then' statement
End With

Finally:

    With NewBatch.Sheets("OUTGOING")
        Bottom = WorksheetFunction.Match((Cells(Rows.Count, 1).End(xlUp)), Range("A:A"), 0)
        .Rows(Bottom + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                .Range("A1").Select
    End With
    Application.DisplayAlerts = False
    Sheets("OUTGOING WIRE").Delete
    Application.DisplayAlerts = True

    End If 'End of If 3 (ACH isn't empty and whether or not wire is empty)
End If '<= These last two 'End If' statements do not have an opening statement? i.e. a corresponding 'If (something = true) Then'

Remember to correctly encapsulate your If statements as they should be within the With statement

With <something>

    If (something = true) Then
        'do something
    ElseIf (somethingElse = true) Then
        'do something else
    Else
        'do fallback
    End If

End With
Источник
Sub YieldSheetUpdate()

Dim RowNumber As Long
Dim WeAreHere As String
Dim wb As Workbook
Dim bFlag As Boolean

'Check to see if the update run date for the spreadsheet is before or after the first of the month for this tab.
'If it's after, then we want to grab the data for the full month to update.
'If it's before, we need to use the StartHistoryDateToGrab and EndHistoryDateToGrab variables to grab the dates in the past.


If Cells(2, 1).Value < Cells(3, 2).Value Then
        'This code handles the update if the entire month is being updated.  This part has been updated for Choice Advantage.
        
        Call FindHandFWorkbook
        
        With Sheets("Sheet1")
            For RowNumber = .UsedRange.Rows.Count To 1 Step -1
                If (Range("A" & RowNumber) = CurrentMonthToUpdate) Then
                    Cells(RowNumber, 1).Activate
                End If
            Next RowNumber
            
            'Grab the data.
            FullMonthRooms = Range(ActiveCell.Offset(0, 12), ActiveCell.Offset((LastDayOfMonth - 1), 12))
            FullMonthGroupRooms = Range(ActiveCell.Offset(0, 8), ActiveCell.Offset((LastDayOfMonth - 1), 8))
            FullMonthADR = Range(ActiveCell.Offset(0, 16), ActiveCell.Offset((LastDayOfMonth - 1), 16))
            
            'Subtract group rooms from full rooms to get transient room totals.
            ReDim FullMonthTransientRooms(LBound(FullMonthRooms, 1) To UBound(FullMonthRooms, 1), LBound(FullMonthRooms, 2) To UBound(FullMonthRooms, 2))
                For i = LBound(FullMonthRooms, 1) To UBound(FullMonthRooms, 1)
                    For j = LBound(FullMonthRooms, 2) To UBound(FullMonthRooms, 2)
                        FullMonthTransientRooms(i, j) = FullMonthRooms(i, j) - FullMonthGroupRooms(i, j)
                    Next j
                Next i
            
            'Now place the data in the appropriate places on the yield sheet.
            Workbooks(YieldSheet).Activate
            
            With ActiveSheet
                Range(ActiveCell.Offset(5, 0), ActiveCell.Offset(5, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(FullMonthTransientRooms)
                Range(ActiveCell.Offset(14, 0), ActiveCell.Offset(14, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(FullMonthGroupRooms)
                Range(ActiveCell.Offset(8, 0), ActiveCell.Offset(8, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(FullMonthADR)
            End With
        End With
        
ElseIf Cells(2, 1).Value > Cells(3, 2).Value And Cells(1, 1).Value < Cells(3, 2).Value Then
        'This code handles the update for the current month when the last update was done in the prior month. This part has been updated for Choice Advantage.
        
        'This portion will pull the historical data from the Daily Statistics workbook.
        Call FindDailyStatisticsWorkbook
        
        With Sheets("Stats")
            For RowNumber = .UsedRange.Rows.Count To 5 Step -1
                If (Range("A" & RowNumber) = StartHistoryDateToGrab) Then
                    Cells(RowNumber, 1).Activate
                End If
            Next RowNumber
            
            HistoryRooms = Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(EndHistoryDateToGrab - (EndHistoryDateToGrabInteger - 1), 1))
            HistoryADR = Range(ActiveCell.Offset(0, 8), ActiveCell.Offset(EndHistoryDateToGrab - (EndHistoryDateToGrabInteger - 1), 8))
        End With
                
        'Pull today and future dates from the Occupancy Snapshot report.
        Call FindHandFWorkbook
        
        With Sheets("Sheet1")
            'Grab the data.
            Range("A5").Select
            
            RemainingCurrentMonthRooms = Range(ActiveCell.Offset(0, 12), ActiveCell.Offset((LastDayOfMonth - (EndHistoryDateToGrabInteger - 1)), 12))
            RemainingCurrentMonthGroupRooms = Range(ActiveCell.Offset(0, 8), ActiveCell.Offset((LastDayOfMonth - (EndHistoryDateToGrabInteger - 1)), 8))
            RemainingCurrentMonthADR = Range(ActiveCell.Offset(0, 16), ActiveCell.Offset((LastDayOfMonth - (EndHistoryDateToGrabInteger - 1)), 16))
            
            'Subtract group rooms from full rooms to get transient room totals.
            ReDim RemainingCurrentMonthTransientRooms(LBound(RemainingCurrentMonthRooms, 1) To UBound(RemainingCurrentMonthRooms, 1), LBound(RemainingCurrentMonthRooms, 2) To UBound(RemainingCurrentMonthRooms, 2))
                For i = LBound(RemainingCurrentMonthRooms, 1) To UBound(RemainingCurrentMonthRooms, 1)
                    For j = LBound(RemainingCurrentMonthRooms, 2) To UBound(RemainingCurrentMonthRooms, 2)
                        RemainingCurrentMonthTransientRooms(i, j) = RemainingCurrentMonthRooms(i, j) - RemainingCurrentMonthGroupRooms(i, j)
                    Next j
                Next i
            
            'Now place these values in the appropriate places on the yield sheet.
            Workbooks(YieldSheet).Activate
        
            With ActiveSheet
                Range(ActiveCell.Offset(5, 0), ActiveCell.Offset(5, (EndHistoryDateToGrabInteger - 2))).Value = Application.WorksheetFunction.Transpose(HistoryRooms)
                Range(ActiveCell.Offset(14, 0), ActiveCell.Offset(14, (EndHistoryDateToGrabInteger - 2))).Value = Application.WorksheetFunction.Transpose(HistoryGroupRooms)
                Range(ActiveCell.Offset(8, 0), ActiveCell.Offset(8, (EndHistoryDateToGrabInteger - 2))).Value = Application.WorksheetFunction.Transpose(HistoryADR)
                Range(ActiveCell.Offset(5, (EndHistoryDateToGrabInteger - 1)), ActiveCell.Offset(5, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(RemainingCurrentMonthRooms)
                Range(ActiveCell.Offset(14, (EndHistoryDateToGrabInteger - 1)), ActiveCell.Offset(14, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(RemainingCurrentMonthGroupRooms)
                Range(ActiveCell.Offset(8, (EndHistoryDateToGrabInteger - 1)), ActiveCell.Offset(8, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(RemainingCurrentMonthADR)
            End With
            
        End With

        
ElseIf Cells(2, 1).Value > CheckMonthEnd Then
        'This code handles the update if the update date is after the month end date.
        
        Call FindDailyStatisticsWorkbook
        
        'Check to see if this is the correct month Daily Statistics workbook.
        With Sheets("Stats")
            If (Range("A5") <> CurrentMonthToUpdate) Then
                MsgBox ("You don't have last month's Daily Statistics spreadsheet open, please open it now")
                    FileToOpen = Application.GetOpenFilename _
                    (Title:="Please select your Daily Statistics report for last month", _
                    FileFilter:="Excel Files *.xlsx (*.xlsx) *.xls (.xls),")
    
                If FileToOpen = False Then
                    MsgBox "No file specified.", vbExclamation, "Duh!!!"
                    Exit Sub
                End If
            End If
        
                    
            For RowNumber = .UsedRange.Rows.Count To 5 Step -1
                If (Range("A" & RowNumber) = StartHistoryDateToGrab) Then
                    Cells(RowNumber, 1).Activate
                End If
            Next RowNumber
            
            'Grab the data
            MonthEndRooms = Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(EndHistoryDateToGrab - (EndHistoryDateToGrabInteger - 1), 1))
            MonthEndADR = Range(ActiveCell.Offset(0, 8), ActiveCell.Offset(EndHistoryDateToGrab - (EndHistoryDateToGrabInteger - 1), 8))
        End With
        
        'Now place the data in the approprate places on the yield sheet.
        Workbooks(YieldSheet).Activate
            
        With ActiveSheet
            Range(ActiveCell.Offset(5, (StartHistoryDateToGrabInteger - 1)), ActiveCell.Offset(5, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(MonthEndRooms)
            Range(ActiveCell.Offset(14, (StartHistoryDateToGrabInteger - 1)), ActiveCell.Offset(14, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(MonthEndGroupRooms)
            Range(ActiveCell.Offset(8, (StartHistoryDateToGrabInteger - 1)), ActiveCell.Offset(8, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(MonthEndADR)
        End With
        
Else
        'This handles current month updates.  It finds the rooms and ADR between the last update and current date, then
        'moves it to the Yield sheet.
        
        'This portion will pull the historical data from the Daily Statistics workbook.
        
        Call FindDailyStatisticsWorkbook
        
        With Sheets("Stats")
            For RowNumber = .UsedRange.Rows.Count To 5 Step -1
                If (Range("A" & RowNumber) = StartHistoryDateToGrab) Then
                    Cells(RowNumber, 1).Activate
                End If
            Next RowNumber
            
            HistoryRooms = Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(EndHistoryDateToGrab - (EndHistoryDateToGrabInteger - 1), 1))
            HistoryADR = Range(ActiveCell.Offset(0, 8), ActiveCell.Offset(EndHistoryDateToGrab - (EndHistoryDateToGrabInteger - 1), 8))
        End With
        
        Call FindHandFWorkbook
        
        With Sheets("Sheet1")
            'Get the transient and group rooms and ADR for today through the end of the month.
            
            Range("A5").Select
            
            RemainingCurrentMonthRooms = Range(ActiveCell.Offset(0, 12), ActiveCell.Offset((LastDayOfMonth - (EndHistoryDateToGrabInteger - 1)), 12))
            RemainingCurrentMonthGroupRooms = Range(ActiveCell.Offset(0, 8), ActiveCell.Offset((LastDayOfMonth - (EndHistoryDateToGrabInteger - 1)), 8))
            RemainingCurrentMonthADR = Range(ActiveCell.Offset(0, 16), ActiveCell.Offset((LastDayOfMonth - (EndHistoryDateToGrabInteger - 1)), 16))
            
            'Subtract group rooms from full rooms to get transient room totals.
            ReDim RemainingCurrentMonthTransientRooms(LBound(RemainingCurrentMonthRooms, 1) To UBound(RemainingCurrentMonthRooms, 1), LBound(RemainingCurrentMonthRooms, 2) To UBound(RemainingCurrentMonthRooms, 2))
                For i = LBound(RemainingCurrentMonthRooms, 1) To UBound(RemainingCurrentMonthRooms, 1)
                    For j = LBound(RemainingCurrentMonthRooms, 2) To UBound(RemainingCurrentMonthRooms, 2)
                        RemainingCurrentMonthTransientRooms(i, j) = RemainingCurrentMonthRooms(i, j) - RemainingCurrentMonthGroupRooms(i, j)
                    Next j
                Next i
            
            'Now place these values in the appropriate places on the yield sheet.
            Workbooks(YieldSheet).Activate
        
            With ActiveSheet
                Range(ActiveCell.Offset(5, (StartHistoryDateToGrabInteger - 1)), ActiveCell.Offset(5, (EndHistoryDateToGrabInteger - 1))).Value = Application.WorksheetFunction.Transpose(HistoryRooms)
                Range(ActiveCell.Offset(14, (StartHistoryDateToGrabInteger - 1)), ActiveCell.Offset(14, (EndHistoryDateToGrabInteger - 1))).Value = Application.WorksheetFunction.Transpose(HistoryGroupRooms)
                Range(ActiveCell.Offset(8, (StartHistoryDateToGrabInteger - 1)), ActiveCell.Offset(8, (EndHistoryDateToGrabInteger - 1))).Value = Application.WorksheetFunction.Transpose(HistoryADR)
                Range(ActiveCell.Offset(5, (EndHistoryDateToGrabInteger - 1)), ActiveCell.Offset(5, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(RemainingCurrentMonthRooms)
                Range(ActiveCell.Offset(14, (EndHistoryDateToGrabInteger - 1)), ActiveCell.Offset(14, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(RemainingCurrentMonthGroupRooms)
                Range(ActiveCell.Offset(8, (EndHistoryDateToGrabInteger - 1)), ActiveCell.Offset(8, (LastDayOfMonth - 1))).Value = Application.WorksheetFunction.Transpose(RemainingCurrentMonthADR)
            End With
        End With
        
End If

End Sub

Источник

Возможно, вам также будет интересно:

  • Emmc id ocr 00ff8080 emmc ошибка включения питания
  • Emission system service required volvo s80 ошибка
  • Emerson industrial automation частотный преобразователь коды ошибок
  • Embraco vcc3 2456 коды ошибок
  • Email ошибка сервера форма не отправлена

    • Понравилась статья? Поделить с друзьями:
    0 0 голоса
    Рейтинг статьи
    Подписаться
    Уведомить о
    guest

    0 комментариев
    Старые
    Новые Популярные
    Межтекстовые Отзывы
    Посмотреть все комментарии