VBA Multiple value setting - vba

Having some issues with user form and setting the initial values, what I'm trying to run is the following:
Sub colorme()
For Each cell In Selection
If cell.Interior.ColorIndex = UserForm1.colorcodeinit.Value Then
With cell
.Interior.ColorIndex = UserForm1.colorcodefin.Value
End With
End If
Next cell
End Sub
However, when I try to run it's not registering for the initial color I'm setting, the following works just fine:
Sub colorme()
For Each cell In Selection
If cell.Interior.ColorIndex = -4142 Then
With cell
.Interior.ColorIndex = UserForm1.colorcodefin.Value
End With
End If
Next cell
End Sub
Thanks for any and all help in advance!

Depending upon how your colorcodeinit control value is set, you may need to ensure the form is fully loaded and open before you try to read any values.
I'm reformatting your code to render in SO/Markdown. There doesn't appear to be anything wrong with the code itself, it's probably just when the code is run that is the problem.
Note that ColorIndex may not be reliable across all Excel users.
Block 1:
'Your first code block
Sub colorme()
For Each cell In Selection
If cell.Interior.ColorIndex = UserForm1.colorcodeinit.Value Then
With cell
.Interior.ColorIndex = UserForm1.colorcodefin.Value
End With
End If
Next cell
End Sub
Block 2:
'Your second code block
Sub colorme()
For Each cell In Selection
If cell.Interior.ColorIndex = -4142 Then
With cell
.Interior.ColorIndex = UserForm1.colorcodefin.Value
End With
End If
Next cell
End Sub

Related

Delete 0's from cell upon entry

I want a macro so that when you enter a 0 into a particular cell/range of cells that it clears the cell.
I wrote a simple macro like this
Sub RemoveZeros()
'to remove 0 values that may be a result of a formula or direct entry.
For Each cell In Range("A1:D20")
If cell.Value = "0" Then cell.Clear
Next
End Sub
However, I have to run this after I have entered my values for it to clear. I would like the cell to clear if a 0 is entered. How do I do this?
I found a solution
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Value = 0 Then Target.ClearContents
Application.EnableEvents = True
End Sub
Thanks

How to run a macro when click merge cell VBA

I want to click a cell and run a macro to make border if the cell doesn't have it, and if the cell has the border it will erase the border. but I can't do it when cell is merged.
This code is only working for normal cell, can't run if I merge L11 and L12 :
If Not Intersect(Target, Range("L11")) Is Nothing Then
If ActiveSheet.Range("L11").Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone And ActiveSheet.Range("L11").Borders(xlEdgeTop).LineStyle <> xlLineStyleNone Then
'if has border erase it.
ActiveSheet.Range("L11").Borders.LineStyle = xlNone
Else
'if doesn't have border create it.
ActiveSheet.Range("L11").Borders.LineStyle = xlContinuous
End If
I try to use same code and change the range but it doesn't work for detect when clicking and for create a border for merge cell.
If Intersect(Target, Range("$M$11:$N$11")) Is Nothing Then
can someone please give me solution for this problem.
Thank you.
I got something working using the Worksheet_SelectionChange event:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone And
Target.Borders(xlEdgeTop).LineStyle <> xlLineStyleNone Then
'if has border erase it.
Target.Borders.LineStyle = xlNone
Else
'if doesn't have border create it.
Target.Borders.LineStyle = xlContinuous
End If
End Sub
When you click on a merged cell, it thinks the range is the top-left cell. In my code, the merged cell is just passed as the "Target", which gives you the reference you need.
If you want to limit this to only some cells, you can filter it by addresses. The
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'//Filter to limit behavior to cell we want:
If InStr(1, Target.AddressLocal, "$L$11") Then '//for a merged cell, .AddressLocal looks something like $L$11:$L$12
If Target.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone And
Target.Borders(xlEdgeTop).LineStyle <> xlLineStyleNone Then
'if has border erase it.
Target.Borders.LineStyle = xlNone
Else
'if doesn't have border create it.
Target.Borders.LineStyle = xlContinuous
End If
End If
End Sub
Because a merged cell has a .AddressLocal in the form of $TopLeftCell:$BottomRightCell, you can filter on the address of the top-left cell to determine which ones get this treatment.
Using the most of your code, a simple one-line does the trick for me:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("L11")) Is Nothing Then Range("L11").MergeArea.Borders.LineStyle = (Range("L11").MergeArea.Borders.LineStyle = 1) + 1
End Sub
You just missed Range.MergeArea ;)

unlock specific area in a protected excel sheet with vba

I have to unlock a specific range (D6:BC116) in a excel sheet. It should be able for other people editing this specific area. So it should be unlocked for them.
At first I manually protect the whole sheet without any code. And after that I want to unprotect the specific area for editing. But something always goes wrong. I have these two codes. The first code has the hidden property it only hides empty cells. The other code I am trying to unprotect specific area I want to edit after protecting the whole sheet.
I am not really sure if the problem is in the first code because of the hidden property? And I am not sure if they are in a relation?
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Range("B6:B112")
If cell.Value <> "" Then
cell.EntireRow.Hidden = False
Else
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
Sub UnlockCells()
Worksheets("Sheet1").Range("D6:BC116").Locked = False
Worksheets("Sheet1").Protect
End Sub
And when I execute this I always get "Index out of range"
Thanks!
I think you need to unprotect before unlocking.
Like this:
With Worksheets("Sheet1")
.Unprotect "MyLongAndSecurePassword"
.Range("D6:BC116").Locked = False
.Protect
End with
Concerning the first part of the code - make sure that you use a variable, which is not named cell, because cell is used by the VBEditor. Name your variable rngCell, myCell or anything else but cell. And declare it like this: Dim rngCell as Range.
Last point - lock your worksheet and try to hide and unhide manually the rows. Is it possible? If not, you know the reason for the error.
Edit:
To check whether the sheet is protected, try this in the Worksheet_Change:
Private Sub Worksheet_Change(ByVal Target As Range)
If Worksheets("Sheet1").ProtectContents Then Exit Sub
For Each cell In Range("B6:B112")
If cell.Value <> "" Then
cell.EntireRow.Hidden = False
Else
cell.EntireRow.Hidden = True
End If
Next cell
End Sub

UserForm to change text to uppercase, lowercase or using proper function

guys!
At this time I created an UserForm to change the letters on my text using three options:
Uppercase
Lowercase
Proper Function
My first code used the If-Then structure and it was ok. I put it below:
Private Sub OkButton_Click()
Dim WorkRange As Range
Dim cell As Range
'Detects only constant type (text; excludes formulas)
On Error Resume Next
Set WorkRange = Selection.SpecialCells(xlCellTypeConstants, xlCellTypeConstants)
'Uppercase
If OptionUpper Then
For Each cell In WorkRange
cell.Value = UCase(cell.Value)
Next cell
End If
'Uppercase
If OptionLower Then
For Each cell In WorkRange
cell.Value = LCase(cell.Value)
Next cell
End If
'Using Proper Function
If OptionProper Then
For Each cell In WorkRange
cell.Value = Application.WorksheetFunction.Proper(cell.Value)
Next cell
End If
Unload UserForm1
End Sub
Private Sub UserForm_Click()
End Sub
I used a mode to run the UserForm1:
Sub ChangeCase2()
If TypeName(Selection) = "Range" Then
UserForm1.Show
Else
MsgBox "Selection a range.", vbCritical
End If
End Sub
And all worked fine. But then I thought: Could it be possible to use Select Case structure? So I tried and unfortunately, didn´t run. The uppercase option works as lowercase while the Lowercase and Proper are working as Uppercase. I reviewed the captions that I gave to the buttons and it´s all fine. Could sb help me, please?
Private Sub CancelButton_Click()
Unload UserForm2
End Sub
Private Sub OkButton_Click()
Dim WorkRange As Range
Dim cell As Range
Dim OptionSelect As Variant
On Error Resume Next
Set WorkRange = Selection.SpecialCells(xlCellTypeConstants, xlCellTypeConstants)
Select Case OptionSelect
Case OptionUpper 'Letras Maiúsculas
For Each cell In WorkRange
cell.Value = UCase(cell.Value)
Next cell
Case OptionLower 'Letras Minúsculas
For Each cell In WorkRange
cell.Value = LCase(cell.Value)
Next cell
Case OptionProper 'Iniciais Maiúsculas
For Each cell In WorkRange
cell.Value = Application.WorksheetFunction.Proper(cell.Value)
Next cell
End Select
Unload UserForm2
End Sub
I used another mode to UserForm2:
Sub ChangeCase3()
If TypeName(Selection) = "Range" Then
UserForm2.Show
Else
MsgBox "Selection a range.", vbCritical
End If
End Sub
instead of
Select Case OptionSelect
use
Select Case True
this will give you the proper value to match OptionButtons Values against
The first code takes the value for OptionSelect from somewhere.
If it worked there, then the problem is that in your second code you have this extra line:
Dim OptionSelect As Variant
On this line you make this value empty, so it will make the Select Case useless as there is no value.

Hide Rows when a specific string is in a cell

I have a problem with VBA in Excel 2007.
I need a macro to hide rows when a specific string is in a cell. (e.g. "System PPP cancelled")
My macro:
Sub HideRows()
Dim Cell As Range
If InStr(Cell, "cancelled") And Rows(Cell.Row).Hidden = False _
Then Rows(Cell.Row).Hidden = True
Next Cell
End Sub
Unfortunately, I get the runtime-error '13'...
Can you help me?
This works in Excel 2010:
Sub hide_cancelled()
For i = 1 To Rows.Count
If InStr(Cells(i, 2).value, "cancelled") And Rows(i).Hidden = False Then
Rows(i).Hidden = True
End If
Next i
End Sub
Note that this will iterate over ALL rows in the spreadsheet, no matter if they contain any data or completely empty. This may take a while! So instead of Rows.Count you should enter a more sane value.
Also this will expect the search value in column 2. Change this in Cells(i,xxx)