I'm trying to lock certain cells, remove any values and change the cell colour based on a users option button selection but cannot get this to work.
For the 2 option buttons, I have the below code but am getting a 400 error - please can someone let me know what I'm missing?
Sub Check_Method_Standard()
ActiveSheet.OptionButtons("Option Button 1").Value = 1
With Me.Range("F18")
.Locked = False
.Interior.Color = 2747637
End With
With Me.Range("F19:F21")
.Locked = True
.Value = Null
.Interior.Color = 16
End With
ActiveSheet.OptionButtons("Option Button 1").Value = -4146
With Me.Range("F19:F21")
.Locked = False
.Interior.Color = 2747637
End With
With Me.Range("F18")
.Locked = True
.Value = Null
.Interior.Color = 16
End With
End Sub
Sub Check_Method_Dual()
ActiveSheet.OptionButtons("Option Button 2").Value = 1
With Me.Range("F19:F21")
.Locked = False
.Interior.Color = 2747637
End With
With Me.Range("F18")
.Locked = True
.Value = Null
.Interior.Color = 16
End With
ActiveSheet.OptionButtons("Option Button 2").Value = -4146
With Me.Range("F18")
.Locked = False
.Interior.Color = 2747637
End With
With Me.Range("F19:F21")
.Locked = True
.Value = Null
.Interior.Color = 16
End With
End Sub
Related
Be gentle guys, I'm not a programmer.
I got this snippit of code off the internet many many moons ago. I would give credit, but I don't remember where it came from.
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Static xRow
Static xColumn
If xColumn <> "" Then
With Columns(xColumn)
.Interior.ColorIndex = xlNone
End With
With Rows(xRow)
.Interior.ColorIndex = xlNone
End With
End If
pRow = Selection.Row
pColumn = Selection.Column
xRow = pRow
xColumn = pColumn
With Columns(pColumn)
.Interior.ColorIndex = 19
.Interior.Pattern = xlSolid
End With
With Rows(pRow)
.Interior.ColorIndex = 19
.Interior.Pattern = xlSolid
End With
End Sub
The above code highlights rows and columns of a selected sell. The problem is that it highlights columns from 1 to 1048576, which causes the vertical scroll bar to get tiny. Plus if there is any color coding in the spreadsheet it screws that up. I decided to write my own highlighter. I put a border around my selected row,column and only do it for 500 rows. It works, almost. The problem is that something in my code cancels the copy command, and will not allow me to paste, which did not happen in the code above. Copy/Paste is a must. Any help would be greatly appreciated.
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Range("A1:N500").Borders(xlEdgeLeft).Weight = xlThin
Range("A1:N500").Borders(xlEdgeTop).Weight = xlThin
Range("A1:N500").Borders(xlEdgeBottom).Weight = xlThin
Range("A1:N500").Borders(xlEdgeRight).Weight = xlThin
Range("A1:N500").Borders(xlInsideVertical).Weight = xlThin
Range("A1:N500").Borders(xlInsideHorizontal).Weight = xlThin
Range("A1:N500").Borders(xlEdgeLeft).Color = vbBlack
Range("A1:N500").Borders(xlEdgeTop).Color = vbBlack
Range("A1:N500").Borders(xlEdgeBottom).Color = vbBlack
Range("A1:N500").Borders(xlEdgeRight).Color = vbBlack
Range("A1:N500").Borders(xlInsideVertical).Color = vbBlack
Range("A1:N500").Borders(xlInsideHorizontal).Color = vbBlack
Dim SplitAddress() As String
SplitAddress = Split(ActiveCell.Address, "$")
Dim RowSelection As String
RowSelection = "A" & SplitAddress(2) & ":" & "N" & SplitAddress(2)
Dim ColSelection As String
ColSelection = SplitAddress(1) & "1" & ":" & SplitAddress(1) & "500"
With Range(RowSelection)
.BorderAround Weight:=xlThick, Color:=RGB(255, 0, 0)
End With
With Range(ColSelection)
.BorderAround Weight:=xlThick, Color:=RGB(255, 0, 0)
End With
End Sub
try this.
it is work in progress
it copies the format, as the default format, from the very last cell in worksheet
the code uses no copy/paste to do the borders
i am still working on copy/paste between cells that you are having trouble with
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim aaa As DisplayFormat
Set aaa = Range("XFD1048576").DisplayFormat ' copy format from very last cell (it is a cheat)
Range("A1:N500").Borders.Color = aaa.Borders.Color ' revert border color to its default
Range("A1:N500").Borders.LineStyle = aaa.Borders.LineStyle
Dim i As Integer
For i = xlEdgeLeft To xlEdgeRight ' loop the four outside borders (7 to 10)
Target.EntireRow.Resize(1, 8).Borders.Item(i).Color = vbRed
Target.EntireRow.Resize(1, 8).Borders.Item(i).Weight = xlThick
Target.EntireColumn.Resize(500, 1).Borders.Item(i).Color = vbRed
Target.EntireColumn.Resize(500, 1).Borders.Item(i).Weight = xlThick
Next i
Application.ScreenUpdating = True
End Sub
I have the following code that should automatically create checkboxes.
Set t = ActiveSheet.Range(Cells(i, 10), Cells(i, 10))
Set chkb = ActiveSheet.CheckBoxes.Add(t.Left, t.Top, t.Width, t.Height)
With chkb
.Caption = ""
.Value = xlOff
.LinkedCell = "S" & i
.Display3DShading = False
.Name = "Check_" & (i - beginningRow + 2) / 2
.OnAction = "checkS"
.Placement = xlMoveAndSize
End With
But when I hide the rows it does not work and I keep seeing them. Any suggestion?
I have a table that I want to completely hide or hide/show rows within the table, depending on whether a cell value is 0 or above.
It looks for a value of 0 within cell D26; if 0 it hides rows 24-51, if not 0 it hides/shows rows depending on whether there is a value in the C column between rows 34 and 49.
The macro below is too slow to be a viable option. Can anyone suggest an alternative way of doing this, that might work in a few seconds rather than a few minutes? I think it's because I'm running the For/If/Else loop.
Sub HideManifolds()
'
' HideManifolds Macro
'
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ChkCol = 3
Manifold1BeginTableRow = 34
Manifold1EndTableRow = 49
Manifold1BeginRow = 24
Manifold1EndRow = 51
For Manifold1RowCnt = Manifold1BeginRow To Manifold1EndRow
If Cells(26, 4).Value = 0 Then
Cells(Manifold1RowCnt, 1).EntireRow.Hidden = True
Else
For Manifold1TableRowCnt = Manifold1BeginTableRow To Manifold1EndTableRow
If Cells(Manifold1TableRowCnt, ChkCol).Value = 0 Then
Cells(Manifold1TableRowCnt, ChkCol).EntireRow.Hidden = True
Else
Cells(Manifold1TableRowCnt, ChkCol).EntireRow.Hidden = False
End If
Next Manifold1TableRowCnt
End If
Next Manifold1RowCnt
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
'
End Sub
I think you don't need this loop For Manifold1RowCnt = Manifold1BeginRow To Manifold1EndRow
code:
Sub HideManifolds()
'
' HideManifolds Macro
'
Dim hRng As Range, vRng As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ChkCol = 3
Manifold1BeginTableRow = 34
Manifold1EndTableRow = 49
Manifold1BeginRow = 24
Manifold1EndRow = 51
If Cells(26, 4).Value = 0 Then
Rows(Manifold1BeginRow & ":" & Manifold1EndRow).Hidden = True
Else
For Manifold1TableRowCnt = Manifold1BeginTableRow To Manifold1EndTableRow
If Cells(Manifold1TableRowCnt, ChkCol).Value = 0 Then
If hRng Is Nothing Then
Set hRng = Cells(Manifold1TableRowCnt, ChkCol)
Else
Set hRng = Union(hRng, Cells(Manifold1TableRowCnt, ChkCol))
End If
Else
If vRng Is Nothing Then
Set vRng = Cells(Manifold1TableRowCnt, ChkCol)
Else
Set vRng = Union(vRng, Cells(Manifold1TableRowCnt, ChkCol))
End If
End If
Next Manifold1TableRowCnt
If Not hRng Is Nothing Then hRng.EntireRow.Hidden = True
If Not vRng Is Nothing Then vRng.EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
'
End Sub
I have two sets of data within my sheet - the first is 1 row per machine, the second is 13 rows per machine. From a drop down box the user will select values from 1, 2, 3, 4, 5, 10, 15, 20, 25, 30 which correspond to the number of machines.
When a value is selected the corresponding rows within the two data sets need to be hidden. For example, if the user selects 5, only the rows for machine 1 to 5 will show.
I have the following code so far, but wondering if there is a simplified way of doing this as I haven't yet added in the individual values (1-5), also how do I have this run when the value is select from the drop down list?
Sub HideRows()
If Range("F19") = "10" Then
Rows("31:60").EntireRow.Hidden = False
Rows("84:473").EntireRow.Hidden = False
Rows("41:60").EntireRow.Hidden = True
Rows("214:473").EntireRow.Hidden = True
ElseIf Range("F19") = "15" Then
Rows("31:60").EntireRow.Hidden = False
Rows("84:473").EntireRow.Hidden = False
Rows("46:60").EntireRow.Hidden = True
Rows("279:473").EntireRow.Hidden = True
ElseIf Range("f19") = "20" Then
Rows("31:60").EntireRow.Hidden = False
Rows("84:473").EntireRow.Hidden = False
Rows("51:60").EntireRow.Hidden = True
Rows("344:473").EntireRow.Hidden = True
ElseIf Range("f19") = "25" Then
Rows("31:60").EntireRow.Hidden = False
Rows("84:473").EntireRow.Hidden = False
Rows("56:60").EntireRow.Hidden = True
Rows("409:473").EntireRow.Hidden = True
ElseIf Range("f19") = "30" Then
Rows("31:60").EntireRow.Hidden = False
Rows("84:473").EntireRow.Hidden = False
End If
End Sub
Thank you
I'm providing a more generic solution. You need to use WOrksheet_Change in the Sheet's Module
Reference: http://msdn.microsoft.com/en-us/library/office/ff839775(v=office.15).aspx
Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print Target.Address
If Target.Address = "$A$1" Then 'change the address to the dropdown box cell you have
Debug.Print Target.Value
NumMachineShow = CLng(Target.Value)
Cells.EntireRow.Hidden = False ' reset, unhidden every row first
Rows(31 + NumMachineShow & ":60").EntireRow.Hidden = True ' hide the unwanted 1 row per machine here
Rows(61 + NumMachineShow * 13 & ":473").EntireRow.Hidden = True ' hide the detail, you need to modify the numbers yourself
End If
End Sub
I have a little problem with my macrocode, and need your advice. Here my base macrocode:
Option Explicit
Sub NurZumUeben()
'oberste Zeile löschen, fixieren und linksbündig ausrichten
Rows("1:1").Select
Selection.Delete Shift:=xlUp
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
'Jede zweite Zeile schattieren
Application.ScreenUpdating = False
Dim Zeile, ZeilenNr As Integer
With ActiveSheet.UsedRange.Rows
.Interior.ColorIndex = xlNone
.Borders.ColorIndex = xlNone
End With
ZeilenNr = 2
For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count
With Rows(Zeile)
If .Hidden = False Then
If ZeilenNr Mod 2 = 0 Then
.Interior.ColorIndex = 15
.Borders.Weight = xlThin
.Borders.ColorIndex = 16
ZeilenNr = ZeilenNr + 1
Else
ZeilenNr = ZeilenNr + 1
End If
End If
End With
Next Zeile
Application.ScreenUpdating = True
'oberste Zeile einfärben
Rows("1:1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Spalte_suchen&formatieren
Dim iLeSpa As Integer
Dim iSpalte As Integer
Dim bGefunden As Boolean
iLeSpa = IIf(IsEmpty(Cells(1, Columns.Count)), Cells(1, _
Columns.Count).End(xlToLeft).Column, Columns.Count)
For iSpalte = 1 To iLeSpa
If Cells(1, iSpalte).Value = "click_thru_pct" Then
bGefunden = True
Exit For
End If
Next iSpalte
If bGefunden Then
With Range(Cells(2, iSpalte), Cells(5000, iSpalte))
.Replace What:="%", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
Range("K1") = 100
Range("K1").Copy
.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide
.NumberFormat = "0.00%"
Range("K1").Clear
End With
Else
MsgBox "Die Überschrift ""click_thru_pct"" wurde nicht gefunden.", _
48, " Hinweis für " & Application.UserName
End If
End Sub
Once thank you all who can help. Unfortunately, I get the final formatting not go quite
Here are the results: example
I did not want to color the entire column but only the top row. In addition, the lower empty fields with ugly 0.00% formatted constantly.
Furthermore, I noticed that after the coloration of the first line, the field K1 is visible. That is with me unfortunately impractical because these Excel documents can also go differently in the row.
Here is the document on which you can test it if necessary.
example
Thank you very much
Change modular function to calculate the for loop variable. I see no purpose in using a separate variable for this. Change this:
ZeilenNr = 2
For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count
With Rows(Zeile)
If .Hidden = False Then
If ZeilenNr Mod 2 = 0 Then
.Interior.ColorIndex = 15
.Borders.Weight = xlThin
.Borders.ColorIndex = 16
ZeilenNr = ZeilenNr + 1
Else
ZeilenNr = ZeilenNr + 1
End If
End If
End With
Next Zeile
To this:
For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count
With Rows(Zeile)
If .Hidden = False Then
If Zeile Mod 2 = 0 Then
.Interior.ColorIndex = 15
.Borders.Weight = xlThin
.Borders.ColorIndex = 16
End If
End If
End With
Next Zeile
I apologize if I am missing something here. Also, I cannot view the examples you provided because the site requires a login and it is not in English. Sorry again.
Within your existing code,
Substitute 5000 with ActiveSheet.UsedRange.Rows.Count
Substitute Range("K1").Clear with Range("K1").ClearContents
Instead of For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count, you could use
For Zeile = 2 To ActiveSheet.Range("A1").CurrentRegion.Rows.Count-1
.UsedRange is not always properly reset. You sample seems a good candidate for .CurrentRegion