Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run-Time error '9' Subscript out of Range
Hello
I am getting an error Run-Time error '9': Subscript out of range on this specific statement. Sheets("Sheet1").Select I get this when someone runs through the macro successfully and than without closing the excel workbook they copy in new data in the SWIMInput worksheet and than tries to run the macro again ctrl+Shift+U I already have logic at the front of the macro looking to see if someone even entered data and than place out a message to close the workbook first. Is there a way to prevent them from entering data in that SWIMInput data once they run through the macro and before they close it? I want them to be able to copy into that SWIMInput worksheet once, run the macro and than NOT enter anything further into SWIMInput until they close and re-open it....or catch that they entred data into it again before closing it and put a message out 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 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 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: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 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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run-Time error '9' Subscript out of Range
The Sheets.Add is creating a new workbook because you didn't use the After
Property. Try these changes Sheets.Add Sheets("Sheet1").Select Sheets("Sheet1").Name = "SWIM Time Data" I updated your entire macro. Avoid using the select method. Also check the variable BR. I don't know if it is the same on all sheets. Your code isn't setting BR as you go from sheet to sheet. 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 With Sheets("SWIMInput").Range("a1") If .FormulaR1C1 < "EDSNETID" Then MsgBox "Please close workbook, re-open, and paste SWIM_Master_Input MSPS info into SWIMInput worksheet" Exit Sub End If End With 'Start of selecting SWIM Time Data deleting and than re-creating With Sheets("SWIM Time Data") Application.CutCopyMode = False .Rows(1).Delete Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Application.DisplayAlerts = False End With Sheets.Add after:=Sheets(Sheets.Count) Set NewSht1 = ActiveSheet NewSht1.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" '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 With Sheets("SWIMInput") br = .Cells(Rows.Count, "b").End(xlUp).Row strDate = Format(Now, "ddmmmyyyy") 'Sort the data Set SortRange = .Rows("2:" & br) SortRange.Sort _ Key1:=.Range("A2"), _ Order1:=xlAscending, _ Header:=xlNo, _ OrderCustom:=1, _ DataOption1:=xlSortTextAsNumbers End With 'MsgBox br 'Select SWIMTimeDataSav as we are going to build the UPLOAD file With Sheets("SWIMTimeDataSav") ' First Clear all contents of worksheet .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 With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("C1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("D1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("E1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("G1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("i1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End With Sheets("SWIMTimeDataSav").Cells.Copy With Sheets("SWIM Time Data") .Cells.PasteSpecial _ Paste:=xlPasteValuesAndNumberFormats 'Wrapping text Begin With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("c1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("d1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("e1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("A1:I1").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: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 End With 'Start of selecting SWIMInput deleting and than re-creating Application.CutCopyMode = False Sheets("SWIMInput").Delete Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Application.DisplayAlerts = False Sheets.Add after:=Sheets(Sheets.Count) Set NewSht3 = ActiveSheet NewSht3.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 With Sheets("SWIMTimeDataSav") Application.CutCopyMode = False .Rows(1).Delete Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete End With 'SWIM WBSE Details worksheet 'Start of pasting to the SWIM WBSE Details worksheet ' Buds logic to clear contents and add SWIM WBSE Details With Sheets("SWIM WBSE Details") Cells.Select .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 Set SortRange = Rows("2:" & br) SortRange.Range("A2").Sort _ Key1:=Range("A2"), _ Order1:=xlAscending, _ Header:=xlNo '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 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").Range("E2").Select End Sub "Bud" wrote: Hello I am getting an error Run-Time error '9': Subscript out of range on this specific statement. Sheets("Sheet1").Select I get this when someone runs through the macro successfully and than without closing the excel workbook they copy in new data in the SWIMInput worksheet and than tries to run the macro again ctrl+Shift+U I already have logic at the front of the macro looking to see if someone even entered data and than place out a message to close the workbook first. Is there a way to prevent them from entering data in that SWIMInput data once they run through the macro and before they close it? I want them to be able to copy into that SWIMInput worksheet once, run the macro and than NOT enter anything further into SWIMInput until they close and re-open it....or catch that they entred data into it again before closing it and put a message out 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 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 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run-Time error '9' Subscript out of Range
I now get a 1004 error ...Cannot rename a sheet to the same name as another
sheet, a referenced object library or a workbook referenced by Visual Basic. Get's the error here....NewSht1.Name = "SWIM Time Data" "Joel" wrote: The Sheets.Add is creating a new workbook because you didn't use the After Property. Try these changes Sheets.Add Sheets("Sheet1").Select Sheets("Sheet1").Name = "SWIM Time Data" I updated your entire macro. Avoid using the select method. Also check the variable BR. I don't know if it is the same on all sheets. Your code isn't setting BR as you go from sheet to sheet. 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 With Sheets("SWIMInput").Range("a1") If .FormulaR1C1 < "EDSNETID" Then MsgBox "Please close workbook, re-open, and paste SWIM_Master_Input MSPS info into SWIMInput worksheet" Exit Sub End If End With 'Start of selecting SWIM Time Data deleting and than re-creating With Sheets("SWIM Time Data") Application.CutCopyMode = False .Rows(1).Delete Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Application.DisplayAlerts = False End With Sheets.Add after:=Sheets(Sheets.Count) Set NewSht1 = ActiveSheet NewSht1.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" '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 With Sheets("SWIMInput") br = .Cells(Rows.Count, "b").End(xlUp).Row strDate = Format(Now, "ddmmmyyyy") 'Sort the data Set SortRange = .Rows("2:" & br) SortRange.Sort _ Key1:=.Range("A2"), _ Order1:=xlAscending, _ Header:=xlNo, _ OrderCustom:=1, _ DataOption1:=xlSortTextAsNumbers End With 'MsgBox br 'Select SWIMTimeDataSav as we are going to build the UPLOAD file With Sheets("SWIMTimeDataSav") ' First Clear all contents of worksheet .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 With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("C1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("D1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("E1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("G1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("i1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End With Sheets("SWIMTimeDataSav").Cells.Copy With Sheets("SWIM Time Data") .Cells.PasteSpecial _ Paste:=xlPasteValuesAndNumberFormats 'Wrapping text Begin With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("c1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("d1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("e1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("A1:I1").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: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 End With 'Start of selecting SWIMInput deleting and than re-creating Application.CutCopyMode = False Sheets("SWIMInput").Delete Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Application.DisplayAlerts = False |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run-Time error '9' Subscript out of Range
You have two sheets with the same name. This is not my problem. Delete one
of the duplicate sheets or change the name of the sheet is the macro. "Joel" wrote: The Sheets.Add is creating a new workbook because you didn't use the After Property. Try these changes Sheets.Add Sheets("Sheet1").Select Sheets("Sheet1").Name = "SWIM Time Data" I updated your entire macro. Avoid using the select method. Also check the variable BR. I don't know if it is the same on all sheets. Your code isn't setting BR as you go from sheet to sheet. 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 With Sheets("SWIMInput").Range("a1") If .FormulaR1C1 < "EDSNETID" Then MsgBox "Please close workbook, re-open, and paste SWIM_Master_Input MSPS info into SWIMInput worksheet" Exit Sub End If End With 'Start of selecting SWIM Time Data deleting and than re-creating With Sheets("SWIM Time Data") Application.CutCopyMode = False .Rows(1).Delete Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Application.DisplayAlerts = False End With Sheets.Add after:=Sheets(Sheets.Count) Set NewSht1 = ActiveSheet NewSht1.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" '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 With Sheets("SWIMInput") br = .Cells(Rows.Count, "b").End(xlUp).Row strDate = Format(Now, "ddmmmyyyy") 'Sort the data Set SortRange = .Rows("2:" & br) SortRange.Sort _ Key1:=.Range("A2"), _ Order1:=xlAscending, _ Header:=xlNo, _ OrderCustom:=1, _ DataOption1:=xlSortTextAsNumbers End With 'MsgBox br 'Select SWIMTimeDataSav as we are going to build the UPLOAD file With Sheets("SWIMTimeDataSav") ' First Clear all contents of worksheet .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 With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("C1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("D1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("E1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("G1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("i1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End With Sheets("SWIMTimeDataSav").Cells.Copy With Sheets("SWIM Time Data") .Cells.PasteSpecial _ Paste:=xlPasteValuesAndNumberFormats 'Wrapping text Begin With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("c1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("d1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("e1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("A1:I1").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: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 End With 'Start of selecting SWIMInput deleting and than re-creating Application.CutCopyMode = False Sheets("SWIMInput").Delete Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Application.DisplayAlerts = False |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run-Time error '9' Subscript out of Range
It's a name already in the workbook...Been there
Sorry, this isn't solving the problem...I'll have to think about some more or ask for other help or something. "Joel" wrote: You have two sheets with the same name. This is not my problem. Delete one of the duplicate sheets or change the name of the sheet is the macro. "Joel" wrote: The Sheets.Add is creating a new workbook because you didn't use the After Property. Try these changes Sheets.Add Sheets("Sheet1").Select Sheets("Sheet1").Name = "SWIM Time Data" I updated your entire macro. Avoid using the select method. Also check the variable BR. I don't know if it is the same on all sheets. Your code isn't setting BR as you go from sheet to sheet. 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 With Sheets("SWIMInput").Range("a1") If .FormulaR1C1 < "EDSNETID" Then MsgBox "Please close workbook, re-open, and paste SWIM_Master_Input MSPS info into SWIMInput worksheet" Exit Sub End If End With 'Start of selecting SWIM Time Data deleting and than re-creating With Sheets("SWIM Time Data") Application.CutCopyMode = False .Rows(1).Delete Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Application.DisplayAlerts = False End With Sheets.Add after:=Sheets(Sheets.Count) Set NewSht1 = ActiveSheet NewSht1.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" '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 With Sheets("SWIMInput") br = .Cells(Rows.Count, "b").End(xlUp).Row strDate = Format(Now, "ddmmmyyyy") 'Sort the data Set SortRange = .Rows("2:" & br) SortRange.Sort _ Key1:=.Range("A2"), _ Order1:=xlAscending, _ Header:=xlNo, _ OrderCustom:=1, _ DataOption1:=xlSortTextAsNumbers End With 'MsgBox br 'Select SWIMTimeDataSav as we are going to build the UPLOAD file With Sheets("SWIMTimeDataSav") ' First Clear all contents of worksheet .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 With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("C1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("D1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("E1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("G1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("i1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End With Sheets("SWIMTimeDataSav").Cells.Copy With Sheets("SWIM Time Data") .Cells.PasteSpecial _ Paste:=xlPasteValuesAndNumberFormats 'Wrapping text Begin With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("c1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("d1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("e1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("A1:I1").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: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 End With 'Start of selecting SWIMInput deleting and than re-creating Application.CutCopyMode = False Sheets("SWIMInput").Delete |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run-Time error '9' Subscript out of Range
You have a lot of good code. Here are some comments that may help you solve
your problems. 1) Do you want to create the new sheets in the same workbook or a new workbook. The original code was creating the sheets in a new workbook. 2) When you are adding sheets do you really want to add the sheets if they are already in the workbook. One thing you can do is check if the sheet exists. if it exists then clear the worksheet, otherwise, add the worksheet. I will modify the code any way you want as long as I'm given the right inputs to work with. Some of the comments in the original code referes to deleting a worksheet and then adding the sheet. I think it is better to check if the worksheet exists and then determining what to do base if the sheet exists. This is code I often use to check if a sheet exists Found = False for each sht in sheets if sht.name = "SWIM Time Data" then Found = True Exit For end if next sht If Found = true then Sheets("SWIM Time Data").Cells.Clearcontents else Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = "SWIM Time Data" End if "Bud" wrote: It's a name already in the workbook...Been there Sorry, this isn't solving the problem...I'll have to think about some more or ask for other help or something. "Joel" wrote: You have two sheets with the same name. This is not my problem. Delete one of the duplicate sheets or change the name of the sheet is the macro. "Joel" wrote: The Sheets.Add is creating a new workbook because you didn't use the After Property. Try these changes Sheets.Add Sheets("Sheet1").Select Sheets("Sheet1").Name = "SWIM Time Data" I updated your entire macro. Avoid using the select method. Also check the variable BR. I don't know if it is the same on all sheets. Your code isn't setting BR as you go from sheet to sheet. 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 With Sheets("SWIMInput").Range("a1") If .FormulaR1C1 < "EDSNETID" Then MsgBox "Please close workbook, re-open, and paste SWIM_Master_Input MSPS info into SWIMInput worksheet" Exit Sub End If End With 'Start of selecting SWIM Time Data deleting and than re-creating With Sheets("SWIM Time Data") Application.CutCopyMode = False .Rows(1).Delete Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Application.DisplayAlerts = False End With Sheets.Add after:=Sheets(Sheets.Count) Set NewSht1 = ActiveSheet NewSht1.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" '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 With Sheets("SWIMInput") br = .Cells(Rows.Count, "b").End(xlUp).Row strDate = Format(Now, "ddmmmyyyy") 'Sort the data Set SortRange = .Rows("2:" & br) SortRange.Sort _ Key1:=.Range("A2"), _ Order1:=xlAscending, _ Header:=xlNo, _ OrderCustom:=1, _ DataOption1:=xlSortTextAsNumbers End With 'MsgBox br 'Select SWIMTimeDataSav as we are going to build the UPLOAD file With Sheets("SWIMTimeDataSav") ' First Clear all contents of worksheet .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 With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("C1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("D1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("E1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("G1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("i1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End With Sheets("SWIMTimeDataSav").Cells.Copy With Sheets("SWIM Time Data") .Cells.PasteSpecial _ Paste:=xlPasteValuesAndNumberFormats 'Wrapping text Begin With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("c1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("d1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("e1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("A1:I1").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: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 End With |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run-Time error '9' Subscript out of Range
Joel
I replied Yes to "Did this post answer the question" to each of your replies and when I hover over it it says that is isn't rated yet. What's the issue with that do you know? maybe it's just a timing thing. "Joel" wrote: You have a lot of good code. Here are some comments that may help you solve your problems. 1) Do you want to create the new sheets in the same workbook or a new workbook. The original code was creating the sheets in a new workbook. 2) When you are adding sheets do you really want to add the sheets if they are already in the workbook. One thing you can do is check if the sheet exists. if it exists then clear the worksheet, otherwise, add the worksheet. I will modify the code any way you want as long as I'm given the right inputs to work with. Some of the comments in the original code referes to deleting a worksheet and then adding the sheet. I think it is better to check if the worksheet exists and then determining what to do base if the sheet exists. This is code I often use to check if a sheet exists Found = False for each sht in sheets if sht.name = "SWIM Time Data" then Found = True Exit For end if next sht If Found = true then Sheets("SWIM Time Data").Cells.Clearcontents else Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = "SWIM Time Data" End if "Bud" wrote: It's a name already in the workbook...Been there Sorry, this isn't solving the problem...I'll have to think about some more or ask for other help or something. "Joel" wrote: You have two sheets with the same name. This is not my problem. Delete one of the duplicate sheets or change the name of the sheet is the macro. "Joel" wrote: The Sheets.Add is creating a new workbook because you didn't use the After Property. Try these changes Sheets.Add Sheets("Sheet1").Select Sheets("Sheet1").Name = "SWIM Time Data" I updated your entire macro. Avoid using the select method. Also check the variable BR. I don't know if it is the same on all sheets. Your code isn't setting BR as you go from sheet to sheet. 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 With Sheets("SWIMInput").Range("a1") If .FormulaR1C1 < "EDSNETID" Then MsgBox "Please close workbook, re-open, and paste SWIM_Master_Input MSPS info into SWIMInput worksheet" Exit Sub End If End With 'Start of selecting SWIM Time Data deleting and than re-creating With Sheets("SWIM Time Data") Application.CutCopyMode = False .Rows(1).Delete Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Application.DisplayAlerts = False End With Sheets.Add after:=Sheets(Sheets.Count) Set NewSht1 = ActiveSheet NewSht1.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" '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 With Sheets("SWIMInput") br = .Cells(Rows.Count, "b").End(xlUp).Row strDate = Format(Now, "ddmmmyyyy") 'Sort the data Set SortRange = .Rows("2:" & br) SortRange.Sort _ Key1:=.Range("A2"), _ Order1:=xlAscending, _ Header:=xlNo, _ OrderCustom:=1, _ DataOption1:=xlSortTextAsNumbers End With 'MsgBox br 'Select SWIMTimeDataSav as we are going to build the UPLOAD file With Sheets("SWIMTimeDataSav") ' First Clear all contents of worksheet .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 With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("C1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("D1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("E1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("G1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("i1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End With Sheets("SWIMTimeDataSav").Cells.Copy With Sheets("SWIM Time Data") .Cells.PasteSpecial _ Paste:=xlPasteValuesAndNumberFormats 'Wrapping text Begin With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("c1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("d1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("e1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run-Time error '9' Subscript out of Range
I don't really care about the rating system. I've been a Two for about 2
years and should be a 1. Microsoft software never works very well. thats why there are so many questions at this site. Microsoft doesn't document there products very well and relies on the users to help each other. "Bud" wrote: Joel I replied Yes to "Did this post answer the question" to each of your replies and when I hover over it it says that is isn't rated yet. What's the issue with that do you know? maybe it's just a timing thing. "Joel" wrote: You have a lot of good code. Here are some comments that may help you solve your problems. 1) Do you want to create the new sheets in the same workbook or a new workbook. The original code was creating the sheets in a new workbook. 2) When you are adding sheets do you really want to add the sheets if they are already in the workbook. One thing you can do is check if the sheet exists. if it exists then clear the worksheet, otherwise, add the worksheet. I will modify the code any way you want as long as I'm given the right inputs to work with. Some of the comments in the original code referes to deleting a worksheet and then adding the sheet. I think it is better to check if the worksheet exists and then determining what to do base if the sheet exists. This is code I often use to check if a sheet exists Found = False for each sht in sheets if sht.name = "SWIM Time Data" then Found = True Exit For end if next sht If Found = true then Sheets("SWIM Time Data").Cells.Clearcontents else Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = "SWIM Time Data" End if "Bud" wrote: It's a name already in the workbook...Been there Sorry, this isn't solving the problem...I'll have to think about some more or ask for other help or something. "Joel" wrote: You have two sheets with the same name. This is not my problem. Delete one of the duplicate sheets or change the name of the sheet is the macro. "Joel" wrote: The Sheets.Add is creating a new workbook because you didn't use the After Property. Try these changes Sheets.Add Sheets("Sheet1").Select Sheets("Sheet1").Name = "SWIM Time Data" I updated your entire macro. Avoid using the select method. Also check the variable BR. I don't know if it is the same on all sheets. Your code isn't setting BR as you go from sheet to sheet. 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 With Sheets("SWIMInput").Range("a1") If .FormulaR1C1 < "EDSNETID" Then MsgBox "Please close workbook, re-open, and paste SWIM_Master_Input MSPS info into SWIMInput worksheet" Exit Sub End If End With 'Start of selecting SWIM Time Data deleting and than re-creating With Sheets("SWIM Time Data") Application.CutCopyMode = False .Rows(1).Delete Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Application.DisplayAlerts = False End With Sheets.Add after:=Sheets(Sheets.Count) Set NewSht1 = ActiveSheet NewSht1.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" '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 With Sheets("SWIMInput") br = .Cells(Rows.Count, "b").End(xlUp).Row strDate = Format(Now, "ddmmmyyyy") 'Sort the data Set SortRange = .Rows("2:" & br) SortRange.Sort _ Key1:=.Range("A2"), _ Order1:=xlAscending, _ Header:=xlNo, _ OrderCustom:=1, _ DataOption1:=xlSortTextAsNumbers End With 'MsgBox br 'Select SWIMTimeDataSav as we are going to build the UPLOAD file With Sheets("SWIMTimeDataSav") ' First Clear all contents of worksheet .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 With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("C1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("D1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("E1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("f1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("G1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("i1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End With Sheets("SWIMTimeDataSav").Cells.Copy With Sheets("SWIM Time Data") .Cells.PasteSpecial _ Paste:=xlPasteValuesAndNumberFormats 'Wrapping text Begin With .Range("B1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("c1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .Range("d1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Run time error 9 (Subscript Out Of Range) | Excel Programming | |||
Run time error 9 (Subscript Out Of Range) | Excel Programming | |||
Run-time error '9': Subscript out of range | Excel Programming | |||
Run-time Error 9: Subscript out of range | Excel Programming | |||
Run time error-subscript out of range | Excel Programming |