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