PDA

View Full Version : repetative code



Scanner
06-30-2015, 01:29 AM
I'm new at this vba coding.
I have a spreadsheet with 420 option buttons in groups of 6 ie group1 = optionbutton1, 71.141,211,281 and 351. Group2 = Optionbutton2,72,142,282 and 352. this is the code I have for changing the background colour based on the value of the button

Private Sub OptionButton1_Change()
With OptionButton1
If .Value Then
.BackColor = vbRed ' or RGB(255, 0, 0)
Else
.BackColor = vbGreen ' or RGB(0,0,0)
End If
End With
End Sub

I need to do this for all 420 option buttons, but this could take a while to replicate and stand more chance of missing entries.
is there a way of shortening this code or changing the code to apply to any option button on the worksheet to change to red on true or green when false.

p45cal
06-30-2015, 05:39 AM
Have a look at http://spreadsheetpage.com/index.php/tip/handle_multiple_userform_buttons_with_one_subroutine/
There a link to a companion file. It does this for multiple Command Buttons on a userform.
I attach this file, but modified to act on OptionButtons on a sheet.
At the moment it's quite specific about which sheet, but a tweak will allow it to work on any or many sheets.
It uses a class module.
The sub GetGoing needs to be run once each time the workbook is opened (it's called in the Workbook_Open event) to group the optionbuttons into a collection. If you reset the vba project/adjust the code, you'll need to run it again.

p45cal
06-30-2015, 05:51 AM
Oh yuk. You've crossposted:
http://stackoverflow.com/questions/31134966/how-can-i-change-the-colour-of-mutiple-optionbuttons-with-as-little-code-as-poss

please Scanner, have a read of http://www.excelguru.ca/content.php?184 and include links to all other cross posts in all the threads where you've cross posted. All forums have similar rules on cross posting.
Ultimately, it'll be for your benefit.

Paul_Hossler
06-30-2015, 08:10 AM
@Scanner -- you have 70 groups of 6 option buttons = 420 total. That sounds like a complicated user interface. What are you trying to do? Can you post a screen shot?

Since you say that you're new to VBA, are all 420 in a userform or as controls on a worksheet?

Scanner
06-30-2015, 08:51 AM
Thanks for the answer, it works, as this is all new to me I will now look to see how to auto run the macro when the workbook opens. just out of interest, how did you know this post was on another forum. Due to a long time spent searching the web I finally succumbed to asking on forums and unsure as to how quick a response would be, I tried two places, and this has given me the simplest and easily understood solution.

p45cal
06-30-2015, 09:12 AM
just out of interest, how did you know this post was on another forumI, like many others, play around on several boards and come across these things - the community is probably tighter-knit than either of us realise. Do read the link I supplied. I for one never respond again to a cross poster unless he supplies links - a simple google search can establish if those links are missing, and prevents me wasting my time duplicating another's response.
ps. The macro does autorun when the workbook opens - no work needed except to copy the workbook_open event sub.

Scanner
07-01-2015, 08:46 AM
13832
this is all active x radio buttons
I look after 70 servers in various companies and perform windows updates every 3 weeks, I connect to them via RDP, by the time I get to server 20 I have lost track as to what point I am with the updates. Some servers I can restart while others I cannot until after hours.
Ideally I would like the cells to change colours but have not found any code to do this hence the radio buttons. once I connect to the remote server I select "server 1" cell and it changes to yellow, if I click again in that cell it will revert back to clear, this just makes it visually clear to see which server I have dealt with. the reset button is to clear all the fields by placing False value in the first row of buttons. this is done just before I start with the process on the 3rd week of the month. If it will be easier I can upload the spreadsheet.

Paul_Hossler
07-01-2015, 10:18 AM
I'd just go with the WS DoubleClick event and use the WS cells instead of 420 option buttons



Option Explicit

Const cServerName As Long = 1
Const cNoUpdates As Long = 2
Const cUpdating As Long = 3
Const cPendingRestart As Long = 4
Const cRestartInitiated As Long = 5
Const cUpdateCompleted As Long = 6
Const cCheck As Long = 254
Const cX As Long = 253


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rData As Range, rCell As Range

Set rCell = Target.Cells(1, 1)
Set rData = Me.Cells(1, 1).CurrentRegion

If Intersect(rCell, rData) Is Nothing Then Exit Sub

With rData.Cells(3, 2).Resize(rData.Rows.Count - 2, rData.Columns.Count - 1)
.Font.Name = "Wingdings"
.Font.Size = 10
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

With rCell
If .Row < 3 Then Exit Sub

Select Case .Column

Case cServerName
If .Interior.Color = vbWhite Then
.Interior.Color = vbYellow
ElseIf .Interior.Color = vbYellow Then
.Interior.Color = xlNone
End If

Case cNoUpdates
If .Interior.Color = vbWhite Then
.Resize(1, 5).Interior.Color = vbGreen
.Resize(1, 5).Value = Chr(cCheck)
ElseIf .Interior.Color = vbGreen Then
.Resize(1, 5).Interior.Color = vbRed
.Resize(1, 5).Value = Chr(cX)
ElseIf .Interior.Color = vbRed Then
.Resize(1, 5).Interior.Color = xlNone
.Resize(1, 5).ClearContents
End If


Case cUpdating To cUpdateCompleted
If .Interior.Color = vbWhite Then
.Interior.Color = vbGreen
.Value = Chr(cCheck)
ElseIf .Interior.Color = vbGreen Then
.Interior.Color = vbRed
.Value = Chr(cX)
ElseIf .Interior.Color = vbRed Then
.Interior.Color = xlNone
.ClearContents
End If

End Select
End With
End Sub

p45cal
07-01-2015, 11:18 AM
Another take; code in worksheet module is:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set myRange = Range("B2:G71")
If Not Intersect(Target, myRange) Is Nothing Then
Intersect(Target.EntireRow, myRange).Value = Empty
Target.Value = "a"
End If
End Sub

Sub resetMe()
Range("C2:G71").Value = Empty
Range("B2:B71").Value = "a"
End Sub
the colours are by conditional formatting.

SamT
07-01-2015, 03:04 PM
And one more version of the Worksheet Module code. Based on the assumption that you use the reset button at the start and that you want everything to not be colored until you doubleclick on a cell. Note that clicking any cell will turn the Server Cell yellow.

Option Explicit


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim LR As Long

LR = Range("A1").CurrentRegion.Rows.Count
If Not Intersect(Range("A3:G" & LR), Target) Is Nothing Then MarkCells Target
End Sub

Private Sub MarkCells(cel As Range)

If cel.Column = 1 Then
SetServer cel
Else
SetCell cel
End If
End Sub



Private Sub SetServer(cel As Range)
'If you doubleclick a yellow Server, this will ask if you want to reset the entire row.
'Click Cancel to ignore.
If cel.Interior.Color = vbWhite Then
cel.Interior.Color = vbYellow
Else
If Not MsgBox("Do you want to set this Row back to White") = vbCancel Then
Range(cel.Resize(1, 6)).Interior.Color = xlNone
Range(cel.Offset(0, 1).Resize).ClearContents
End If
End If

End Sub

Private Sub SetCell(cel As Range)
Const cCheck As Long = 254
Const cX As Long = 253
Dim CelValue As String

CelValue = cel.Value
ResetRowColor cel.Row

Select Case CelValue
Case "": cel.Value = cCheck
Case cCheck
cel.Value = cX
cel.Interior.Color = vbRed
Case cX: ResetRowColor cel.Row
End Select
End Sub


Private Sub ResetRowColor(Rw As Long)
Range("A" & Rw).Interior.Color = vbYellow
Range(Cells(Rw, 2), Cells(Rw, 6)).Interior.Color = vbGreen
End Sub


Sub ResetButton_Code()
'Assign this code to the Reset Button
Dim LR As Long
LR = Range("A1").CurrentRegion.Rows.Count
Range("A3:G" & LR).Interior.Color = xlNone
Range("B3:G" & LR).Value = ""
End Sub


Private Sub RunOnce_FormatDataRange()
'Only need to be run once to set the data range to accept the other code
'OR, you can manually format the table.
'
'To run, put the cursor in the sub and press F5

Dim LR As Long
LR = Range("A1").CurrentRegion.Rows.Count

With Range("B3:G" & LR)
.Font.Name = "Wingdings"
.Font.Size = 10
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End Sub

Scanner
07-02-2015, 03:26 AM
Thanks p45cal
this is clean and tidy with very little coding and will do the job

Paul_Hossler
07-02-2015, 06:23 AM
@Scanner -- glad p45cal's works for you. Lots easier than 420 option buttons

Few comments for you

1. Remember the range is hard code =Range("B2:G71") so expand or contract it when your list of servers changes

2. I was thinking that you wanted the Bx - Gx range to be all checked and go Green when a step was completed. Right now it's only the last double-clicked step that goes Red with a check, and the rest of the cells in that row revert to Green

13844