lundi 16 septembre 2019

Can someone help solve this VBA Compile Error: Else without if? All the IFs are closed in the body of the script

Blockquote

I am working on an Excel file that gets duplicated numerous times when the "Split" macro is run less one sheet. It used to work fine.

I've since added a segment requiring a new sheet to be included that wasn't in existence when the original was created. To do this I copied other segments of code where they occurred for all other sheets but now I get a compile error; Else without IF.

I've matched away all of the IF to Else / EndIF and I cannot find a mismatch. The Else does have an open IF.

Public wb As Workbook, swb As Workbook, wks As Worksheet, wks2 As Worksheet, src As Worksheet, a1 As Long, Str As Object, country As Object, agencyn As String, fname As Long, countryname As String, rng As Range, rngcountry As Range, country2 As Range, i As Long, Day As String, Month As String, Year As Long, Arr As Variant, ii As Long, iii As Long, iiii As Long
Sub Split()

'system actions
With Application
.ScreenUpdating = False
 .DisplayAlerts = False
  .EnableEvents = True
End With

'timer
StartTime = Timer
    Agency.Combobox1.AddItem "PHD"
    Agency.Combobox1.AddItem "Mediacom"
    Agency.Show

'folder selection for files
With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            MyDir = .SelectedItems(1)
        End If
    End With
        If Right(MyDir, 1) <> "\" Then
            MyDir = MyDir & "\"
        End If
            Myfile = Dir(MyDir & "*.*")
            ChDir MyDir

'variables
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fld = FSO.GetFolder(MyDir)
Set swb = ThisWorkbook
Set wks = ThisWorkbook.Sheets("Central Benchmarks")
    i = wks.Cells(Rows.Count, "A").End(xlUp).Row
    Set wks2 = swb.Sheets.Add(After:=Sheets(Sheets.Count))

'----------------------------
'Sort agency, market, brand

'central benchmarks
    Sheets("Central Benchmarks").Select
    'sort by agency, country, brand
    Range("A1:P1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Central Benchmarks").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Central Benchmarks").Sort.SortFields.Add Key:= _
        Range("A2:A20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("Central Benchmarks").Sort.SortFields.Add Key:= _
        Range("C2:C20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("Central Benchmarks").Sort.SortFields.Add Key:= _
        Range("D2:D20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Central Benchmarks").Sort
        .SetRange Range("A1:P20000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With



'country & agency to new sheet
With wks
    .Range("A1:A" & i).Copy
    wks2.Range("A1:A" & i).PasteSpecial xlPasteValues
    .Range("C1:C" & i).Copy
    wks2.Range("B1:B" & i).PasteSpecial xlPasteValues
    wks2.Range("$A$2:$B" & i).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo 'changed from yes
    ii = wks2.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = wks2.Range("A2:A" & ii)
End With

For Each Str In rng
If Str = agencyn Then
Set wb = Workbooks.Add
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveWindow.DisplayGridlines = False
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveWindow.DisplayGridlines = False
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveWindow.DisplayGridlines = False
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveWindow.DisplayGridlines = False
    'added by am 09/09/19
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveWindow.DisplayGridlines = False


 'name sheets
    wb.Sheets(1).Name = "Central Benchmarks"
    wb.Sheets(2).Name = "Funding"
    wb.Sheets(3).Name = "Flighting"
    wb.Sheets(4).Name = "Media Channels"
    wb.Sheets(5).Name = "Results"
    wb.Sheets(6).Name = "Flighting (Search)"

    wks.Range("A2:Z2").Copy wb.Sheets(1).Range("A2:Z2")
    swb.Sheets(4).Range("A1:AV20000").Copy wb.Sheets(2).Range("A1:AV20000")
    swb.Sheets(5).Range("A1:DX20000").Copy wb.Sheets(3).Range("A1:DX20000")
    swb.Sheets(6).Range("A1:AV20000").Copy wb.Sheets(4).Range("A1:AV20000")
    swb.Sheets(7).Range("A1:AF20000").Copy wb.Sheets(5).Range("A1:AF20000")
    'added by am 09/09/19
    swb.Sheets(7).Range("A1:BH20000").Copy wb.Sheets(5).Range("A1:BH20000")

Set rngcountry = wks.Range("C2:C" & i) 'prev c3
For Each country In rngcountry
If country.Offset(0, -2).Value = agencyn Then
If country.Value = Str.Offset(0, 1).Value Then
    countryname = country.Value
    iii = wb.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    country.EntireRow.Copy wb.Sheets(1).Cells(iii, 1).EntireRow
    wks.Range("T2:V45").Copy wb.Sheets(1).Cells(2, 20)

With wb
    .Sheets(1).Columns("A:E").ColumnWidth = 20
    ' Agency to be pasted in other Sheets
    .Sheets(1).Range("A3:A" & iii).Copy
    .Sheets(2).Range("A10:A" & iii + 7).PasteSpecial
    .Sheets(3).Range("A10:A" & iii + 7).PasteSpecial
    .Sheets(4).Range("A10:A" & iii + 7).PasteSpecial
    .Sheets(5).Range("A10:A" & iii + 7).PasteSpecial
    .Sheets(6).Range("A10:A" & iii + 7).PasteSpecial

    ' Country to be pasted in other Sheets
    .Sheets(1).Range("C3:C" & iii).Copy
    .Sheets(2).Range("B10:B" & iii + 7).PasteSpecial
    .Sheets(3).Range("B10:B" & iii + 7).PasteSpecial
    .Sheets(4).Range("B10:B" & iii + 7).PasteSpecial
    .Sheets(5).Range("B10:B" & iii + 7).PasteSpecial
    .Sheets(6).Range("A10:A" & iii + 7).PasteSpecial

    ' Brand to be pasted in other sheets
    .Sheets(1).Range("D3:D" & iii).Copy
    .Sheets(2).Range("C10:C" & iii + 7).PasteSpecial
    .Sheets(3).Range("C10:C" & iii + 7).PasteSpecial
    .Sheets(4).Range("C10:C" & iii + 7).PasteSpecial
    .Sheets(5).Range("C10:C" & iii + 7).PasteSpecial
    .Sheets(6).Range("A10:A" & iii + 7).PasteSpecial

    'Category to be pasted in other sheets
    .Sheets(1).Range("E3:E" & iii).Copy
    .Sheets(2).Range("D10:D" & iii + 7).PasteSpecial
    .Sheets(3).Range("D10:D" & iii + 7).PasteSpecial
    .Sheets(4).Range("D10:D" & iii + 7).PasteSpecial
    .Sheets(5).Range("D10:D" & iii + 7).PasteSpecial
    .Sheets(6).Range("A10:A" & iii + 7).PasteSpecial

    ' PM 2.0 Classification to be pasted in other sheets
    .Sheets(1).Range("F3:F" & iii).Copy
    .Sheets(2).Range("E10:E" & iii + 7).PasteSpecial
    .Sheets(3).Range("E10:E" & iii + 7).PasteSpecial
    .Sheets(4).Range("E10:E" & iii + 7).PasteSpecial
    .Sheets(5).Range("E10:E" & iii + 7).PasteSpecial
    .Sheets(6).Range("A10:A" & iii + 7).PasteSpecial

    ' New PM 2.0 Classification to be pasted in other sheets
    .Sheets(1).Range("G3:G" & iii).Copy
    .Sheets(2).Range("F10:F" & iii + 7).PasteSpecial
    .Sheets(3).Range("F10:F" & iii + 7).PasteSpecial
    .Sheets(4).Range("F10:F" & iii + 7).PasteSpecial
    .Sheets(5).Range("F10:F" & iii + 7).PasteSpecial
    .Sheets(6).Range("A10:A" & iii + 7).PasteSpecial

    .Sheets(1).Range("H3:H" & iii).Copy           ' Market Share
    .Sheets(2).Range("H10:H" & iii + 7).PasteSpecial
    .Sheets(1).Range("I3:I" & iii).Copy           ' Absolute Spend
    .Sheets(2).Range("K10:K" & iii + 7).PasteSpecial
    .Sheets(1).Range("J3:J" & iii).Copy           ' Peak Weekly GBP Weight
    .Sheets(3).Range("H10:H" & iii + 7).PasteSpecial
    .Sheets(1).Range("K3:K" & iii).Copy           ' Seasonal/NonSeasonal
    .Sheets(3).Range("I10:I" & iii + 7).PasteSpecial
    .Sheets(1).Range("L3:L" & iii).Copy           ' Minimum number of weeks
    .Sheets(3).Range("J10:J" & iii + 7).PasteSpecial


 'flighting sort
 '
    Rows("9:9").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Flighting").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Flighting").Sort.SortFields.Add Key:=Range( _
        "A10:A20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Flighting").Sort.SortFields.Add Key:=Range( _
        "B10:B20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Flighting").Sort.SortFields.Add Key:=Range( _
        "C10:C20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Flighting").Sort
        .SetRange Range("A9:AI20000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Search flighting sort
 '
    Rows("9:9").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Flighting (Search)").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Flighting (Search)").Sort.SortFields.Add Key:=Range( _
        "A10:A20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Flighting (Search)").Sort.SortFields.Add Key:=Range( _
        "B10:B20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Flighting (Search)").Sort.SortFields.Add Key:=Range( _
        "C10:C20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Flighting (Search)").Sort
        .SetRange Range("A9:AI20000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

 'funding sort
 '
    Rows("9:9").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("funding").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("funding").Sort.SortFields.Add Key:=Range( _
        "A10:A20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("funding").Sort.SortFields.Add Key:=Range( _
        "B10:B20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("funding").Sort.SortFields.Add Key:=Range( _
        "C10:C20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("funding").Sort
        .SetRange Range("A9:AI20000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

 'media channels sort
 '
    Rows("9:9").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Media Channels").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Media Channels").Sort.SortFields.Add Key:=Range( _
        "A10:A20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Media Channels").Sort.SortFields.Add Key:=Range( _
        "B10:B20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Media Channels").Sort.SortFields.Add Key:=Range( _
        "C10:C20000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Media Channels").Sort
        .SetRange Range("A9:AI20000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    .Sheets(2).Columns("A:L").ColumnWidth = 20
    .Sheets(2).Columns("M:AF").ColumnWidth = 40
    .Sheets(2).Rows("9:9").RowHeight = 30

    .Sheets(3).Columns("A:E").ColumnWidth = 20
    .Sheets(3).Columns("F:DX").ColumnWidth = 20
    .Sheets(3).Rows("9:9").RowHeight = 30

    .Sheets(4).Columns("A:E").ColumnWidth = 20
    .Sheets(4).Columns("F:AF").ColumnWidth = 40
    .Sheets(4).Rows("9:9").RowHeight = 30

    .Sheets(6).Columns("A:E").ColumnWidth = 20
    .Sheets(6).Columns("F:BH").ColumnWidth = 20
    .Sheets(6).Rows("9:9").RowHeight = 30

    '-------------
    'hide columns

    'funding
    .Sheets(2).Columns("E").EntireColumn.Hidden = True
    .Sheets(2).Columns("J").EntireColumn.Hidden = True
    .Sheets(2).Columns("L").EntireColumn.Hidden = True
    .Sheets(2).Columns("N").EntireColumn.Hidden = True
    .Sheets(2).Columns("O").EntireColumn.Hidden = True
    .Sheets(2).Columns("S").EntireColumn.Hidden = True
    .Sheets(2).Columns("V").EntireColumn.Hidden = True
    .Sheets(2).Columns("X").EntireColumn.Hidden = True
    .Sheets(2).Columns("Y").EntireColumn.Hidden = True
    .Sheets(2).Columns("Z").EntireColumn.Hidden = True
    .Sheets(2).Columns("AB:AC").EntireColumn.Hidden = True

    'flighting
    .Sheets(3).Columns("E").EntireColumn.Hidden = True
    .Sheets(3).Columns("BL:DR").EntireColumn.Hidden = True
    .Sheets(3).Columns("DT").EntireColumn.Hidden = True
    .Sheets(3).Columns("DU").EntireColumn.Hidden = True

    'media channels
    .Sheets(4).Columns("E").EntireColumn.Hidden = True
    .Sheets(4).Columns("G").EntireColumn.Hidden = True
    .Sheets(4).Columns("X").EntireColumn.Hidden = True
    .Sheets(4).Columns("Y").EntireColumn.Hidden = True
    .Sheets(4).Columns("AA:AB").EntireColumn.Hidden = True
    .Sheets(4).Columns("AG:AI").EntireColumn.Hidden = True

    'Search flighting
    .Sheets(6).Columns("BF").EntireColumn.Hidden = True


    .Sheets(2).Activate
End With
Else
End If
Else
End If
Next country

'-----------------------------------
'flighting

With wb
 iiii = wb.Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row
    .Sheets(3).Range("A10:K" & iiii).Copy
    .Sheets(3).Range("A" & iiii + 1).PasteSpecial
 iiii = wb.Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row
    .Sheets(3).Range("A" & iiii + 1).PasteSpecial
 iiii = wb.Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row
    .Sheets(3).Range("A" & iiii + 1).PasteSpecial
 iiii = wb.Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row
    .Sheets(3).Range("A" & iiii + 1).PasteSpecial
 iiii = wb.Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row

'------------
'flighting

'sort
   ActiveWorkbook.Worksheets("Flighting").Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("Flighting").Sort.SortFields.Add Key:=Range("C10:C" & iiii), SortOn:=xlSortOnValues, Order:=xlAscending, _
   DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Flighting").Sort
        .SetRange Range("C9:j" & iiii)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With



'-----------------------------------
'Search flighting

With wb
 iiii = wb.Sheets(6).Cells(Rows.Count, "A").End(xlUp).Row
    .Sheets(6).Range("A10:K" & iiii).Copy
    .Sheets(6).Range("A" & iiii + 1).PasteSpecial
 iiii = wb.Sheets(6).Cells(Rows.Count, "A").End(xlUp).Row
    .Sheets(6).Range("A" & iiii + 1).PasteSpecial
 iiii = wb.Sheets(6).Cells(Rows.Count, "A").End(xlUp).Row
    .Sheets(6).Range("A" & iiii + 1).PasteSpecial
 iiii = wb.Sheets(6).Cells(Rows.Count, "A").End(xlUp).Row
    .Sheets(6).Range("A" & iiii + 1).PasteSpecial
 iiii = wb.Sheets(6).Cells(Rows.Count, "A").End(xlUp).Row

'------------
'Search flighting

'sort
   ActiveWorkbook.Worksheets("Search Flighting").Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("Search Flighting").Sort.SortFields.Add Key:=Range("C10:C" & iiii), SortOn:=xlSortOnValues, Order:=xlAscending, _
   DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Flighting").Sort
        .SetRange Range("C9:j" & iiii)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With



'clear out file barber shop
        Cells.Replace What:="[Bayer Media principles tracker.xlsm]", _
        Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
        False, SearchFormat:=False, ReplaceFormat:=False

' remove row 1 from central benchmarks
    Sheets("Central Benchmarks").Select
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range("$A$2:$V$2000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
        , 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22), Header:=xlNo

Cells.Replace What:= _
        "[Bayer Media principles tracker.xlsm]", _
        Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
        False, SearchFormat:=False, ReplaceFormat:=False


    .SaveAs fld & "\" & agencyn & "-" & countryname & "-Media_Principles.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    .Close True

End With
Else
End If
Next Str
    wks2.Delete

'system tools
With Application
    .ScreenUpdating = True
     .DisplayAlerts = True
       .CutCopyMode = False
End With

'system counter
    SecondsElapsed = Round(Timer - StartTime, 2)
    MsgBox "The file has been split by country in " & SecondsElapsed & " seconds!", vbInformation
End Sub

Aucun commentaire:

Enregistrer un commentaire