Situation: I am building a excel sheet with several automated actions - done with macros.
The 1st macro is for creating a new project and it copies the last aktive row with contents and pastes it one row below and clears the cell contents of defined cells in the row.
The 2nd macro copies a row defined by the placement of the cursor in a row and pastes that row below the last row of cell with contents.
These macros work well.
By introducing a further macro (3rd macro) to automate an action in that, when you pick a specific case in a dropdown menu, a text is written into cell xx. The macro works fine and does what is expected.
Error: when I create a new project (runs the 1st macro) I get a debug error 13 and the line "Case "#6_qualified project":.. is highlighted yellow.
What am I doing wrong?
Thanks for your help.
Marc
Here are the 3 macros:
_______________________________ Private Sub CommandButton3_Click()
Sheets("Uebersicht").Unprotect Password:="xxx"
myCheck = MsgBox("new poject?", vbYesNo)
If myCheck = vbNo Then Exit Sub
Application.ScreenUpdating = False
ActiveSheet.Range("R65536").End(xlUp).EntireRow.Select
Selection.Copy
ActiveSheet.Range("R65536").End(xlUp).Offset(1, 0).EntireRow.Select
Selection.Insert
Range("P" & (ActiveCell.Row)).Value = Date
Intersect(Range("L:M,R:R,T:U,AB:BC"), ActiveCell.EntireRow).ClearContents
ActiveSheet.Range("R65536").End(xlUp).Offset(1, 0).EntireRow.Select
Range("L" & (ActiveCell.Row)).Select
Application.ScreenUpdating = True
End Sub
__________________________________________
Private Sub CommandButton4_Click()
Sheets("Uebersicht").Unprotect Password:="SBB"
myCheck = MsgBox("copy and paste row?", vbYesNo)
If myCheck = vbNo Then Exit Sub
Application.ScreenUpdating = False
ActiveCell.EntireRow.Copy
ActiveSheet.Range("R65536").End(xlUp).Offset(1, 0).EntireRow.Select
Selection.Insert
Range("P" & (ActiveCell.Row)).Value = Date
Intersect(Range("AB:AD,AL:AM,AO:BC"), ActiveCell.EntireRow).ClearContents
ActiveSheet.Range("R65536").End(xlUp).Offset(1, 0).EntireRow.Select
Range("L" & (ActiveCell.Row)).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Application.ScreenUpdating = True
'Sheets("Uebersicht").Protect Password:="SBB", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End Sub
_________________________________
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("U2:U65536")) Is Nothing Then
Select Case Target.Value
Case "#6_qualified project": Target.Offset(, 17).Value = "PA created and approve"
Case "#10_finance ready": Target.Offset(, 17).Value = "BP created and approve"
End Select
End If
End Sub
The 1st macro is for creating a new project and it copies the last aktive row with contents and pastes it one row below and clears the cell contents of defined cells in the row.
The 2nd macro copies a row defined by the placement of the cursor in a row and pastes that row below the last row of cell with contents.
These macros work well.
By introducing a further macro (3rd macro) to automate an action in that, when you pick a specific case in a dropdown menu, a text is written into cell xx. The macro works fine and does what is expected.
Error: when I create a new project (runs the 1st macro) I get a debug error 13 and the line "Case "#6_qualified project":.. is highlighted yellow.
What am I doing wrong?
Thanks for your help.
Marc
Here are the 3 macros:
_______________________________ Private Sub CommandButton3_Click()
Sheets("Uebersicht").Unprotect Password:="xxx"
myCheck = MsgBox("new poject?", vbYesNo)
If myCheck = vbNo Then Exit Sub
Application.ScreenUpdating = False
ActiveSheet.Range("R65536").End(xlUp).EntireRow.Select
Selection.Copy
ActiveSheet.Range("R65536").End(xlUp).Offset(1, 0).EntireRow.Select
Selection.Insert
Range("P" & (ActiveCell.Row)).Value = Date
Intersect(Range("L:M,R:R,T:U,AB:BC"), ActiveCell.EntireRow).ClearContents
ActiveSheet.Range("R65536").End(xlUp).Offset(1, 0).EntireRow.Select
Range("L" & (ActiveCell.Row)).Select
Application.ScreenUpdating = True
End Sub
__________________________________________
Private Sub CommandButton4_Click()
Sheets("Uebersicht").Unprotect Password:="SBB"
myCheck = MsgBox("copy and paste row?", vbYesNo)
If myCheck = vbNo Then Exit Sub
Application.ScreenUpdating = False
ActiveCell.EntireRow.Copy
ActiveSheet.Range("R65536").End(xlUp).Offset(1, 0).EntireRow.Select
Selection.Insert
Range("P" & (ActiveCell.Row)).Value = Date
Intersect(Range("AB:AD,AL:AM,AO:BC"), ActiveCell.EntireRow).ClearContents
ActiveSheet.Range("R65536").End(xlUp).Offset(1, 0).EntireRow.Select
Range("L" & (ActiveCell.Row)).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Application.ScreenUpdating = True
'Sheets("Uebersicht").Protect Password:="SBB", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End Sub
_________________________________
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("U2:U65536")) Is Nothing Then
Select Case Target.Value
Case "#6_qualified project": Target.Offset(, 17).Value = "PA created and approve"
Case "#10_finance ready": Target.Offset(, 17).Value = "BP created and approve"
End Select
End If
End Sub