Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Allow macro to work for a group of cells but not the other cells
Hello,
I am working on a workbook where a group of cells must change with a macro button which will be triggered by a user. Insert value and color. The value is used in a formel in another cell. If value input is wrong the user can reset the cell with a macro button. Problem: 1. First Macro works throughout the worksheet and I only want it to be able to work in 5 groups of cells 2. Second Macro (reset macro) The reset macro can delete the formel if this cell is chosen so I need it to function only in the same groups as the first macro. The code for insert av value and color Sub mrkArbeidstid() ' ' mrkArbeidstid Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False With Selection.Interior .ColorIndex = 35 .Pattern = xlSolid End With Selection.Interior.ColorIndex = 35 Selection.Font.ColorIndex = 35 Selection.FormulaR1C1 = "a" ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True The code for reset Sub mrkTilbakestill() ' ' mrkTilbakestill Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False With Selection.Interior Selection.ClearContents Selection.Interior.ColorIndex = xlNone End With ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True I am just about learning this so if there's someone who has an answer for me I would be very gratefull Eric |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Allow macro to work for a group of cells but not the other cells
Hi Eric,
Try assigning the two following procedures to buttons: '=========== Public Sub mrkArbeidstid() ' ' mrkTilbakestill Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen Dim Rng As Range Dim Rng2 As Range Dim rArea As Range Set Rng = ActiveSheet.Range("A1:D20") '<<=== CHANGE On Error Resume Next Set Rng2 = Intersect(Selection, Rng) On Error GoTo 0 If Rng2 Is Nothing Then Exit Sub End If ActiveSheet.Unprotect For Each rArea In Rng2.Areas With rArea .Font.ColorIndex = 35 .Formula = "a" With .Interior .ColorIndex = 35 .Pattern = xlSolid End With End With Next rArea ActiveSheet.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True End Sub '------------- Public Sub mrkTilbakestill() ' ' mrkTilbakestill Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen Dim Rng As Range Dim Rng2 As Range Dim rArea As Range Set Rng = ActiveSheet.Range("A1:D20") '<<=== CHANGE On Error Resume Next Set Rng2 = Intersect(Selection, Rng) On Error GoTo 0 If Rng2 Is Nothing Then Exit Sub End If ActiveSheet.Unprotect For Each rArea In Rng2.Areas With rArea .Interior.ColorIndex = xlNone .ClearContents End With Next rArea ActiveSheet.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True End Sub '<<=========== --- Regards. Norman wrote in message ... Hello, I am working on a workbook where a group of cells must change with a macro button which will be triggered by a user. Insert value and color. The value is used in a formel in another cell. If value input is wrong the user can reset the cell with a macro button. Problem: 1. First Macro works throughout the worksheet and I only want it to be able to work in 5 groups of cells 2. Second Macro (reset macro) The reset macro can delete the formel if this cell is chosen so I need it to function only in the same groups as the first macro. The code for insert av value and color Sub mrkArbeidstid() ' ' mrkArbeidstid Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False With Selection.Interior .ColorIndex = 35 .Pattern = xlSolid End With Selection.Interior.ColorIndex = 35 Selection.Font.ColorIndex = 35 Selection.FormulaR1C1 = "a" ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True The code for reset Sub mrkTilbakestill() ' ' mrkTilbakestill Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False With Selection.Interior Selection.ClearContents Selection.Interior.ColorIndex = xlNone End With ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True I am just about learning this so if there's someone who has an answer for me I would be very gratefull Eric |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Allow macro to work for a group of cells but not the other cells
On 3 mei, 20:18, "Norman Jones"
wrote: Hi Eric, Try assigning the two following procedures to buttons: '=========== Public Sub mrkArbeidstid() ' ' mrkTilbakestill Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen * * Dim Rng As Range * * Dim Rng2 As Range * * Dim rArea As Range * * Set Rng = ActiveSheet.Range("A1:D20") * *'<<=== CHANGE * * On Error Resume Next * * Set Rng2 = Intersect(Selection, Rng) * * On Error GoTo 0 * * If Rng2 Is Nothing Then * * * * Exit Sub * * End If * * ActiveSheet.Unprotect * * For Each rArea In Rng2.Areas * * * * With rArea * * * * * * .Font.ColorIndex = 35 * * * * * * .Formula = "a" * * * * * * With .Interior * * * * * * * * .ColorIndex = 35 * * * * * * * * .Pattern = xlSolid * * * * * * End With * * * * End With * * Next rArea * * ActiveSheet.Protect _ * * * * * * DrawingObjects:=True, _ * * * * * * Contents:=True, _ * * * * * * Scenarios:=True End Sub '------------- Public Sub mrkTilbakestill() ' ' mrkTilbakestill Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen * * Dim Rng As Range * * Dim Rng2 As Range * * Dim rArea As Range * * Set Rng = ActiveSheet.Range("A1:D20") * *'<<=== CHANGE * * On Error Resume Next * * Set Rng2 = Intersect(Selection, Rng) * * On Error GoTo 0 * * If Rng2 Is Nothing Then * * * * Exit Sub * * End If * * ActiveSheet.Unprotect * * For Each rArea In Rng2.Areas * * * * With rArea * * * * * * .Interior.ColorIndex = xlNone * * * * * * .ClearContents * * * * End With * * Next rArea * * ActiveSheet.Protect _ * * * * * * DrawingObjects:=True, _ * * * * * * Contents:=True, _ * * * * * * Scenarios:=True End Sub '<<=========== --- Regards. Norman wrote in message ... Hello, I am working on a workbook where a group of cells must change with a macro button which will be triggered by a user. Insert value and color. The value is used in a formel in another cell. If value input is wrong the user can reset the cell with a macro button. Problem: 1. First Macro works throughout the worksheet and I only want it to be able to work in 5 groups of cells 2. Second Macro (reset macro) The reset macro can delete the formel if this cell is chosen so I need it to function only in the same groups as the first macro. The code for insert av value and color Sub mrkArbeidstid() ' ' mrkArbeidstid Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen * *ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False * *With Selection.Interior * * * *.ColorIndex = 35 * * * *.Pattern = xlSolid * *End With * *Selection.Interior.ColorIndex = 35 * *Selection.Font.ColorIndex = 35 * *Selection.FormulaR1C1 = "a" * *ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True The code for reset Sub mrkTilbakestill() ' ' mrkTilbakestill Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen * *ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False * *With Selection.Interior * * * *Selection.ClearContents * * * *Selection.Interior.ColorIndex = xlNone * *End With * *ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True I am just about learning this so if there's someone who has an answer for me I would be very gratefull Eric- Tekst uit oorspronkelijk bericht niet weergeven - - Tekst uit oorspronkelijk bericht weergeven - Thank you for quick and usefull help. It works fantastic. There is only one thing that is missing now and that is to protect the sheet with a password. I thought that that would be easy since I saw several examples in this discusion group. But as always, nothing is as easy as it looks. I tried the following but get an error message for the ActiveSheet.Protect part. Can you help me out with this? ActiveSheet.Unprotect Password:="test" For Each rArea In Rng2.Areas With rArea .Font.ColorIndex = 35 .Formula = "a" With .Interior .ColorIndex = 35 .Pattern = xlSolid End With End With Next rArea ActiveSheet.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True Password:="test" Thanks Eric |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Password protect it
Hello I did as you suggested and it work good. The problem now is to prtect it with a password. I tried a view things which I read in this discussion group but I can't get it to work. I manage to unprotect the password but not to protect it again. I protected the sheet with password as normal in excell The macro unprotects but doesn't protect with password afterwards. Can you help out,. Eric code ActiveSheet.Unprotect Password:="test" For Each rArea In Rng2.Areas With rArea .Font.ColorIndex = 35 .Formula = "a" With .Interior .ColorIndex = 35 .Pattern = xlSolid End With End With Next rArea ActiveSheet.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True ActiveSheet.Protect Password:="test" |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Allow macro to work for a group of cells but not the other cells
Hi Eric,
At the top of a standard module, brfore any other code try the following minor modificarion: '=========== Option Explicit Const PWORD As String = "Pluto" '<<=== CHANGE '------------- Public Sub mrkArbeidstid() ' ' mrkTilbakestill Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen Dim Rng As Range Dim rng2 As Range Dim rArea As Range Set Rng = ActiveSheet.Range("A1:D20") '<<=== CHANGE On Error Resume Next Set rng2 = Intersect(Selection, Rng) On Error GoTo 0 If rng2 Is Nothing Then Exit Sub End If ActiveSheet.Unprotect Password:=PWORD For Each rArea In rng2.Areas With rArea .Font.ColorIndex = 35 .Formula = "a" With .Interior .ColorIndex = 35 .Pattern = xlSolid End With End With Next rArea ActiveSheet.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True End Sub '------------- Public Sub mrkTilbakestill() ' ' mrkTilbakestill Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen Dim Rng As Range Dim rng2 As Range Dim rArea As Range Set Rng = ActiveSheet.Range("A1:D20") '<<=== CHANGE On Error Resume Next Set rng2 = Intersect(Selection, Rng) On Error GoTo 0 If rng2 Is Nothing Then Exit Sub End If ActiveSheet.Unprotect For Each rArea In rng2.Areas With rArea .Interior.ColorIndex = xlNone .ClearContents End With Next rArea ActiveSheet.Protect _ Password:=PWORD, _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True End Sub '<<=========== --- Regards. Norman wrote in message ... On 3 mei, 20:18, "Norman Jones" Thank you for quick and usefull help. It works fantastic. There is only one thing that is missing now and that is to protect the sheet with a password. I thought that that would be easy since I saw several examples in this discusion group. But as always, nothing is as easy as it looks. I tried the following but get an error message for the ActiveSheet.Protect part. Can you help me out with this? ActiveSheet.Unprotect Password:="test" For Each rArea In Rng2.Areas With rArea .Font.ColorIndex = 35 .Formula = "a" With .Interior .ColorIndex = 35 .Pattern = xlSolid End With End With Next rArea ActiveSheet.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True Password:="test" Thanks Eric |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Allow macro to work for a group of cells but not the other cells
Hi Eric,
Please replce the previous code with: '=========== Option Explicit Const PWORD As String = "Pluto" '------------- Public Sub mrkArbeidstid() ' ' mrkTilbakestill Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen Dim Rng As Range Dim rng2 As Range Dim rArea As Range Set Rng = ActiveSheet.Range("A1:D20") '<<=== CHANGE On Error Resume Next Set rng2 = Intersect(Selection, Rng) On Error GoTo 0 If rng2 Is Nothing Then Exit Sub End If ActiveSheet.Unprotect _ Password:=PWORD For Each rArea In rng2.Areas With rArea .Font.ColorIndex = 35 .Formula = "a" With .Interior .ColorIndex = 35 .Pattern = xlSolid End With End With Next rArea ActiveSheet.Protect _ Password:=PWORD, _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True End Sub '------------- Public Sub mrkTilbakestill() ' ' mrkTilbakestill Makro ' Makro registrert 22.01.2008 TPS og EG ' Registrerer arbeidstid for maskin og dekksbesetningen Dim Rng As Range Dim rng2 As Range Dim rArea As Range Set Rng = ActiveSheet.Range("A1:D20") '<<=== CHANGE On Error Resume Next Set rng2 = Intersect(Selection, Rng) On Error GoTo 0 If rng2 Is Nothing Then Exit Sub End If ActiveSheet.Unprotect Password:=PWORD For Each rArea In rng2.Areas With rArea .Interior.ColorIndex = xlNone .ClearContents End With Next rArea ActiveSheet.Protect _ Password:=PWORD, _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True End Sub '<<=========== --- Regards. Norman |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Password protect it
Hi Eric,
See the password reply in the main thread. --- Regards. Norman wrote in message ... Hello I did as you suggested and it work good. The problem now is to prtect it with a password. I tried a view things which I read in this discussion group but I can't get it to work. I manage to unprotect the password but not to protect it again. I protected the sheet with password as normal in excell The macro unprotects but doesn't protect with password afterwards. Can you help out,. Eric code ActiveSheet.Unprotect Password:="test" For Each rArea In Rng2.Areas With rArea .Font.ColorIndex = 35 .Formula = "a" With .Interior .ColorIndex = 35 .Pattern = xlSolid End With End With Next rArea ActiveSheet.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True ActiveSheet.Protect Password:="test" |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Password protect it
Thanks Norman
It works beautyfull now. So much you can do with just a bit of code. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Match a group of cells with another group of cells | Excel Worksheet Functions | |||
Copy Data from One Group of Cells to Another Group | Charts and Charting in Excel | |||
from a group of cells.find average of cells containing values | Excel Discussion (Misc queries) | |||
Macro to delete a group of CELLS | Excel Discussion (Misc queries) | |||
copy group of cells to another group of cells using "IF" in third | Excel Worksheet Functions |