B
Bud
Hello
I am using some code someone gave me to try when I was having run-time error
'9' subscript out of range.
I changed some of the code to position the sheets exactly where I wanted them
So instead of using
Sheets.Add after:=Sheets(Sheets.Count)
Set NewSht1 = ActiveSheet
NewSht1.Name = "SWIM Time Data"
I am using this to position the sheet right after the 3rd sheet
Sheets.Add after:=Sheets(3)
Set NewSht1 = ActiveSheet
NewSht1.Name = "SWIM Time Data"
What I am having a problem with is that I delete the 1st sheet but when I
try and use Sheets(0) I get an abend
This is the code...I placed a 1 in and it adds it after what is now the 1st
sheet after I first delete SWIMInput. However, I want to add back the
SWIMINPUT right back where I deleted it from which is the first sheet in the
workbook.
How can I do this? ...I am getting a subscript out of range
'Start of selecting SWIMInput deleting and than re-creating
Sheets("SWIMInput").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets.Add after:=Sheets(1)
Set NewSht3 = ActiveSheet
NewSht3.Name = "SWIMInput"
Sub SWIM()
'
' SWIM Macro
' Macro recorded 1/10/2009 by czj63c
' Bud Zeiger
'
' Keyboard Shortcut: Ctrl+Shift+U
'
'Let's check to see if we have any data or the right data
Sheets("SWIMInput").Select
Range("a1").Select
If ActiveCell.FormulaR1C1 <> "EDSNETID" Then
MsgBox "Please close workbook, re-open, and paste SWIM_Master_Input
MSPS info into SWIMInput worksheet"
Exit Sub
End If
'Start of selecting SWIM Time Data deleting and than re-creating
Sheets("SWIM Time Data").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets.Add after:=Sheets(3)
Set NewSht1 = ActiveSheet
NewSht1.Name = "SWIM Time Data"
'Sheets.Add
'If Err = 9 Then
' Err.Clear
' MsgBox "Please close workbook, re-open, and paste SWIM_Master_Input
MSPS info into SWIMInput worksheet"
'End If
'Sheets("Sheet1").Select
'Sheets("Sheet1").Name = "SWIM Time Data"
'End of selecting SWIM Time Data deleting and than re-creating
'Start of adding SWIMTimeDataSav so it can be used a temp area
Sheets.Add after:=Sheets(Sheets.Count)
Set NewSht2 = ActiveSheet
NewSht2.Name = "SWIMTimeDataSav"
'Sheets.Add
'Sheets("Sheet2").Select
'Sheets("Sheet2").Name = "SWIMTimeDataSav"
'End of adding temporary SWIMTimeDataSav
'This next statement turns off the screen updating while the macro is
running
Application.ScreenUpdating = False
Dim br As Long
Dim strDate As String 'Current system date
'Select SAPTasks and count the number of active rows
Sheets("SWIMInput").Select
Cells.Select
br = Cells(Rows.Count, "b").End(xlUp).Row
strDate = Format(Now, "ddmmmyyyy")
'Sort the data
Range("A2").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
'MsgBox br
'Select SWIMTimeDataSav as we are going to build the UPLOAD file
Sheets("SWIMTimeDataSav").Select
Cells.Select
' First Clear all contents of worksheet
ActiveSheet.Cells.ClearContents
' Second Add a line that describes the data fields
' Also add the formulas for obtaining the data
Cells(1, "a") = "Employee"
Cells(1, "b") = "Date (dd-mmm-yyyy)"
Cells(1, "c") = "Start Time (hh:mm)"
Cells(1, "d") = "End Time (hh:mm)"
Cells(1, "e") = "Duration (Hrs)"
Cells(1, "f") = "Work Breakdown Structure Element(WBSE)"
Cells(1, "g") = "Line Item Text"
Cells(1, "h") = "Employee Name"
Cells(1, "i") = "Project Name"
Cells(2, "a") = "=SWIMInput!A2" 'Employee
Cells(2, "b") = strDate 'Todays date
Cells(2, "g") = "=SWIMInput!B2" 'Task Name
Cells(2, "f") = "=SWIMInput!C2" 'WBSE
Cells(2, "i") = "=SWIMInput!D2" 'Project Name
' The next matching formula concatenates the number of records in
SWIMInput for knowing when to stop on the fill down
Cells(2, "h") = "=IF($a$2:$a$" & br & "="""","""",(INDEX('SWIM Employee
Details'!$c$1:$c$1000,MATCH($a$2:$a" & br & ",'SWIM Employee
Details'!$A$1:$A$1000,0))))"
' Thirdly Auto fill down for the number rows we obtained from the
SAP-Simulation
If br > 2 Then
Cells(2, "a").AutoFill Destination:=Range(Cells(2, "a"), Cells(br,
"a"))
'Cells(2, "b").AutoFill Destination:=Range(Cells(2, "b"), Cells(br,
"b"))
' Changed B to copy instead so the value does not increase by one
each row filling down
Cells(2, "b").Copy Destination:=Range(Cells(2, "b"), Cells(br, "b"))
Cells(2, "f").AutoFill Destination:=Range(Cells(2, "f"), Cells(br,
"f"))
Cells(2, "g").AutoFill Destination:=Range(Cells(2, "g"), Cells(br,
"g"))
Cells(2, "i").AutoFill Destination:=Range(Cells(2, "i"), Cells(br,
"i"))
Cells(2, "h").AutoFill Destination:=Range(Cells(2, "h"), Cells(br,
"h"))
End If
'Wrapping text Begin
Range("B1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("E1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("f1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("G1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("i1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("SWIMTimeDataSav").Select
Cells.Select
Selection.Copy
Sheets("SWIM Time Data").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'Wrapping text Begin
Range("B1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("c1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("d1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("e1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("f1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1:I1").Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Rows("1:1").RowHeight = 39.75
Columns("A:A").ColumnWidth = 7.8
Columns("B:B").ColumnWidth = 13.13
Columns("C:C").ColumnWidth = 9.5
Columns("D
").ColumnWidth = 7.4
Columns("E:E").ColumnWidth = 7.75
Columns("F:F").ColumnWidth = 24.75
Columns("g:g").ColumnWidth = 44.25
Columns("h:h").ColumnWidth = 13.5
Columns("i:i").ColumnWidth = 20.7
'Start of selecting SWIMInput deleting and than re-creating
Sheets("SWIMInput").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets.Add after:=Sheets(1)
Set NewSht3 = ActiveSheet
NewSht3.Name = "SWIMInput"
'Sheets.Add
'Sheets("Sheet3").Select
'Sheets("Sheet3").Name = "SWIMInput"
'End of selecting SWIMInput deleting and than re-creating
'Hiding the saved file
'Sheets("SWIMTimeDataSav").Select
'ActiveWindow.SelectedSheets.Visible = False
'Start of selecting temporary built file SWIMTimeDataSav and deleting it
Sheets("SWIMTimeDataSav").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
'SWIM WBSE Details worksheet
'Start of pasting to the SWIM WBSE Details worksheet
' Buds logic to clear contents and add SWIM WBSE Details
Sheets("SWIM WBSE Details").Select
Cells.Select
ActiveSheet.Cells.ClearContents ' First Clear all contents of worksheet
Cells(1, "a") = "WBSE Number" ' Second Add a line that
describes the data fields
Cells(1, "b") = "WBSE Description" ' Second Add a line that
describes the data fields
Cells(1, "c") = "Project Cost Centre" ' Second Add a line that
describes the data fields
' Also add the formulas for obtaining the data
Cells(2, "a") = "='SWIM Time Data'!F2" 'WBSE Number
Cells(2, "b") = "='SWIM Time Data'!I2" 'Project name
'An alternative to Buds logic to clear contents and add SWIM WBSE Details
'Sheets("SWIM WBSE Details").Activate
'Mike H suggested this from Microsofts discussion group Excel programming
'
' With Sheets("SWIM WBSE Details")
' .UsedRange.ClearContents ' First Clear all contents of
worksheet
' .Cells(1, "b") = "WBSE Description"
' .Cells(1, "c") = "Project Cost Centre"
' .Cells(2, "a") = "='SWIM Time Data'!F2" 'WBSE Number
' .Cells(2, "b") = "='SWIM Time Data'!I2" 'Project name
' End With
' Thirdly Auto fill down for the number rows we obtained from the
SAP-Simulation
If br > 2 Then
Cells(2, "a").AutoFill Destination:=Range(Cells(2, "a"), Cells(br,
"a"))
Cells(2, "b").AutoFill Destination:=Range(Cells(2, "b"), Cells(br,
"b"))
End If
'After copying the data over with above logic the next two lines will
recopy and paste the values themselves
' instead of having the reference formula in the field
Range("A2:b" & br).Copy
Range("A2").PasteSpecial Paste:=xlPasteValues
Columns("A:A").ColumnWidth = 24.75
Columns("B:B").ColumnWidth = 20.7
Range("A2").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Start Deleting duplicates for the WBSE Details worksheet to have only one
'Chip Pearson suggested this from Microsofts discussion group Excel
programming Thank You Chip
Dim LastRow As Long
Dim RowNdx As Long
Dim StartRow As Long
Dim WS As Worksheet
Dim RR As Range
Dim ColumnLetter As String
'Change the StartRow value to the row number at which the sorted data
starts.
'Change ColumnLetter to the column which will be examined for duplicates.
StartRow = 2 '<<< CHANGE AS REQUIRED
ColumnLetter = "A" '<<< CHANGE AS REQUIRED
Set WS = ActiveSheet
With WS
LastRow = .Cells(.Rows.Count, ColumnLetter).End(xlUp).Row
For RowNdx = LastRow To StartRow + 1 Step -1
Set RR = .Range(.Cells(StartRow, ColumnLetter), _
.Cells(RowNdx - 1, ColumnLetter))
If Application.CountIf(RR, .Cells(RowNdx, ColumnLetter)) <> 0 Then
.Rows(RowNdx).Delete
End If
Next RowNdx
End With
'End Deleting duplicates for the WBSE Details worksheet to have only one
Sheets("SWIM Time Data").Select
Cells.Select
Range("E2").Select
End Sub
I am using some code someone gave me to try when I was having run-time error
'9' subscript out of range.
I changed some of the code to position the sheets exactly where I wanted them
So instead of using
Sheets.Add after:=Sheets(Sheets.Count)
Set NewSht1 = ActiveSheet
NewSht1.Name = "SWIM Time Data"
I am using this to position the sheet right after the 3rd sheet
Sheets.Add after:=Sheets(3)
Set NewSht1 = ActiveSheet
NewSht1.Name = "SWIM Time Data"
What I am having a problem with is that I delete the 1st sheet but when I
try and use Sheets(0) I get an abend
This is the code...I placed a 1 in and it adds it after what is now the 1st
sheet after I first delete SWIMInput. However, I want to add back the
SWIMINPUT right back where I deleted it from which is the first sheet in the
workbook.
How can I do this? ...I am getting a subscript out of range
'Start of selecting SWIMInput deleting and than re-creating
Sheets("SWIMInput").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets.Add after:=Sheets(1)
Set NewSht3 = ActiveSheet
NewSht3.Name = "SWIMInput"
Sub SWIM()
'
' SWIM Macro
' Macro recorded 1/10/2009 by czj63c
' Bud Zeiger
'
' Keyboard Shortcut: Ctrl+Shift+U
'
'Let's check to see if we have any data or the right data
Sheets("SWIMInput").Select
Range("a1").Select
If ActiveCell.FormulaR1C1 <> "EDSNETID" Then
MsgBox "Please close workbook, re-open, and paste SWIM_Master_Input
MSPS info into SWIMInput worksheet"
Exit Sub
End If
'Start of selecting SWIM Time Data deleting and than re-creating
Sheets("SWIM Time Data").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets.Add after:=Sheets(3)
Set NewSht1 = ActiveSheet
NewSht1.Name = "SWIM Time Data"
'Sheets.Add
'If Err = 9 Then
' Err.Clear
' MsgBox "Please close workbook, re-open, and paste SWIM_Master_Input
MSPS info into SWIMInput worksheet"
'End If
'Sheets("Sheet1").Select
'Sheets("Sheet1").Name = "SWIM Time Data"
'End of selecting SWIM Time Data deleting and than re-creating
'Start of adding SWIMTimeDataSav so it can be used a temp area
Sheets.Add after:=Sheets(Sheets.Count)
Set NewSht2 = ActiveSheet
NewSht2.Name = "SWIMTimeDataSav"
'Sheets.Add
'Sheets("Sheet2").Select
'Sheets("Sheet2").Name = "SWIMTimeDataSav"
'End of adding temporary SWIMTimeDataSav
'This next statement turns off the screen updating while the macro is
running
Application.ScreenUpdating = False
Dim br As Long
Dim strDate As String 'Current system date
'Select SAPTasks and count the number of active rows
Sheets("SWIMInput").Select
Cells.Select
br = Cells(Rows.Count, "b").End(xlUp).Row
strDate = Format(Now, "ddmmmyyyy")
'Sort the data
Range("A2").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
'MsgBox br
'Select SWIMTimeDataSav as we are going to build the UPLOAD file
Sheets("SWIMTimeDataSav").Select
Cells.Select
' First Clear all contents of worksheet
ActiveSheet.Cells.ClearContents
' Second Add a line that describes the data fields
' Also add the formulas for obtaining the data
Cells(1, "a") = "Employee"
Cells(1, "b") = "Date (dd-mmm-yyyy)"
Cells(1, "c") = "Start Time (hh:mm)"
Cells(1, "d") = "End Time (hh:mm)"
Cells(1, "e") = "Duration (Hrs)"
Cells(1, "f") = "Work Breakdown Structure Element(WBSE)"
Cells(1, "g") = "Line Item Text"
Cells(1, "h") = "Employee Name"
Cells(1, "i") = "Project Name"
Cells(2, "a") = "=SWIMInput!A2" 'Employee
Cells(2, "b") = strDate 'Todays date
Cells(2, "g") = "=SWIMInput!B2" 'Task Name
Cells(2, "f") = "=SWIMInput!C2" 'WBSE
Cells(2, "i") = "=SWIMInput!D2" 'Project Name
' The next matching formula concatenates the number of records in
SWIMInput for knowing when to stop on the fill down
Cells(2, "h") = "=IF($a$2:$a$" & br & "="""","""",(INDEX('SWIM Employee
Details'!$c$1:$c$1000,MATCH($a$2:$a" & br & ",'SWIM Employee
Details'!$A$1:$A$1000,0))))"
' Thirdly Auto fill down for the number rows we obtained from the
SAP-Simulation
If br > 2 Then
Cells(2, "a").AutoFill Destination:=Range(Cells(2, "a"), Cells(br,
"a"))
'Cells(2, "b").AutoFill Destination:=Range(Cells(2, "b"), Cells(br,
"b"))
' Changed B to copy instead so the value does not increase by one
each row filling down
Cells(2, "b").Copy Destination:=Range(Cells(2, "b"), Cells(br, "b"))
Cells(2, "f").AutoFill Destination:=Range(Cells(2, "f"), Cells(br,
"f"))
Cells(2, "g").AutoFill Destination:=Range(Cells(2, "g"), Cells(br,
"g"))
Cells(2, "i").AutoFill Destination:=Range(Cells(2, "i"), Cells(br,
"i"))
Cells(2, "h").AutoFill Destination:=Range(Cells(2, "h"), Cells(br,
"h"))
End If
'Wrapping text Begin
Range("B1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("E1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("f1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("G1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("i1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("SWIMTimeDataSav").Select
Cells.Select
Selection.Copy
Sheets("SWIM Time Data").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'Wrapping text Begin
Range("B1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("c1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("d1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("e1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("f1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1:I1").Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Rows("1:1").RowHeight = 39.75
Columns("A:A").ColumnWidth = 7.8
Columns("B:B").ColumnWidth = 13.13
Columns("C:C").ColumnWidth = 9.5
Columns("D
").ColumnWidth = 7.4Columns("E:E").ColumnWidth = 7.75
Columns("F:F").ColumnWidth = 24.75
Columns("g:g").ColumnWidth = 44.25
Columns("h:h").ColumnWidth = 13.5
Columns("i:i").ColumnWidth = 20.7
'Start of selecting SWIMInput deleting and than re-creating
Sheets("SWIMInput").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets.Add after:=Sheets(1)
Set NewSht3 = ActiveSheet
NewSht3.Name = "SWIMInput"
'Sheets.Add
'Sheets("Sheet3").Select
'Sheets("Sheet3").Name = "SWIMInput"
'End of selecting SWIMInput deleting and than re-creating
'Hiding the saved file
'Sheets("SWIMTimeDataSav").Select
'ActiveWindow.SelectedSheets.Visible = False
'Start of selecting temporary built file SWIMTimeDataSav and deleting it
Sheets("SWIMTimeDataSav").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
'SWIM WBSE Details worksheet
'Start of pasting to the SWIM WBSE Details worksheet
' Buds logic to clear contents and add SWIM WBSE Details
Sheets("SWIM WBSE Details").Select
Cells.Select
ActiveSheet.Cells.ClearContents ' First Clear all contents of worksheet
Cells(1, "a") = "WBSE Number" ' Second Add a line that
describes the data fields
Cells(1, "b") = "WBSE Description" ' Second Add a line that
describes the data fields
Cells(1, "c") = "Project Cost Centre" ' Second Add a line that
describes the data fields
' Also add the formulas for obtaining the data
Cells(2, "a") = "='SWIM Time Data'!F2" 'WBSE Number
Cells(2, "b") = "='SWIM Time Data'!I2" 'Project name
'An alternative to Buds logic to clear contents and add SWIM WBSE Details
'Sheets("SWIM WBSE Details").Activate
'Mike H suggested this from Microsofts discussion group Excel programming
'
' With Sheets("SWIM WBSE Details")
' .UsedRange.ClearContents ' First Clear all contents of
worksheet
' .Cells(1, "b") = "WBSE Description"
' .Cells(1, "c") = "Project Cost Centre"
' .Cells(2, "a") = "='SWIM Time Data'!F2" 'WBSE Number
' .Cells(2, "b") = "='SWIM Time Data'!I2" 'Project name
' End With
' Thirdly Auto fill down for the number rows we obtained from the
SAP-Simulation
If br > 2 Then
Cells(2, "a").AutoFill Destination:=Range(Cells(2, "a"), Cells(br,
"a"))
Cells(2, "b").AutoFill Destination:=Range(Cells(2, "b"), Cells(br,
"b"))
End If
'After copying the data over with above logic the next two lines will
recopy and paste the values themselves
' instead of having the reference formula in the field
Range("A2:b" & br).Copy
Range("A2").PasteSpecial Paste:=xlPasteValues
Columns("A:A").ColumnWidth = 24.75
Columns("B:B").ColumnWidth = 20.7
Range("A2").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Start Deleting duplicates for the WBSE Details worksheet to have only one
'Chip Pearson suggested this from Microsofts discussion group Excel
programming Thank You Chip
Dim LastRow As Long
Dim RowNdx As Long
Dim StartRow As Long
Dim WS As Worksheet
Dim RR As Range
Dim ColumnLetter As String
'Change the StartRow value to the row number at which the sorted data
starts.
'Change ColumnLetter to the column which will be examined for duplicates.
StartRow = 2 '<<< CHANGE AS REQUIRED
ColumnLetter = "A" '<<< CHANGE AS REQUIRED
Set WS = ActiveSheet
With WS
LastRow = .Cells(.Rows.Count, ColumnLetter).End(xlUp).Row
For RowNdx = LastRow To StartRow + 1 Step -1
Set RR = .Range(.Cells(StartRow, ColumnLetter), _
.Cells(RowNdx - 1, ColumnLetter))
If Application.CountIf(RR, .Cells(RowNdx, ColumnLetter)) <> 0 Then
.Rows(RowNdx).Delete
End If
Next RowNdx
End With
'End Deleting duplicates for the WBSE Details worksheet to have only one
Sheets("SWIM Time Data").Select
Cells.Select
Range("E2").Select
End Sub