Hello I get some data from website using custom function with an XMLHTTP request now I need to apply some formatting condition to copied data and I would appreciate some advice using VBA :
The active cell "B" column
Less than 10 red
Between 10 and 15 yellow
More than 15 green
all the cell not returning any number should be blank
THX
There are two ways to do this:
The easy way:
Use Excel built-in conditional formatting (Select your range and click Home tab > Conditional Formatting > Add a rule or choose from the default rules -I think it has extensive options enough for your needs.)
The philosophical way:
Add a new module from your VBA IDE.
Copy and paste this code:
Sub ColorRange()
Dim d as Double
Dim r As Range
Set r = ActiveSheet.Range("B1:B500")
For Cell in r
If Cell.Text <> "" And IsNumeric(Cell.Value) = True Then
If Cell.Text < 10 Then
Cell.Interior.Color = RGB(255, 0, 0)
ElseIf Cell.Text >= 10 And Cell.Text <= 15 Then
Cell.Interior.Color = RGB(255, 255, 0)
Else
Cell.Interior.Color = RGB(0, 255, 0)
End If
End If
Next
End Sub
and run the macro.
Here's an output sample:
Which one I recommend?
I would recommend you use conditional formatting, no need for the VBA magic if the good old built-in Excel features can handle it, unless your need prove otherwise.
Related
New to VBA in excel, but hoping to get some help with a macro while I find my feet. Any help would be greatly appreciated.
I have a workbook where I would like to automatically colour tabs based on the tab names. My tab/sheet names are often codes. Some of my existing sheet names (for example) are:
CIS22ABC
CIS22CBA
NAS22XYZ
NAS22ZXY
MY DATA
ADMIN, etc.
I am trying to implement a script that runs across entire Workbook (i.e. under "ThisWorkbook") that searches first 3 letters of every tab name and makes tab colours based on these letters. There are lots of sheets being added and removed all the time - so an array of names won't work.
In short, I am hoping to do the following:
If first 3 letter of sheet name = "CIS" then Tab.Color = RGB(0, 255, 255)
If first 3 letter of sheet name = "NAS" then Tab.Color = RGB(66, 134, 244)
Otherwise do nothing!
Again, any help would be great. Thank you.
This will automatically execute every time you add a new sheet.
There are a good amount of events you can tie this to in order to have the macro fire automatically without user intervention. A few notable ones that may suit your needs better than the NewSheet event that I used below are SheetChange, SheetBeforeDelete, SheetActivate, etc.
This code will need to be placed in the coding space under ThisWorkbook rather a sheet or module in VBE.
Option Explicit
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim ws As Worksheet
For Each ws In Worksheets
Select Case Left(ws.Name, 3)
Case "CIS"
ws.Tab.Color = RGB(0, 255, 255)
Case "NAS"
ws.Tab.Color = RGB(66, 134, 244)
'Case "ABC"
'Add as many of these as you need inbetween _
Select Case and End Select
End Select
Next ws
End Sub
Try this:
Dim sheet As Worksheet
For Each sheet In ActiveWorkbook.Worksheets
Dim name As String
name = sheet.name
If Len(name) > 3 Then
Dim bit As String
bit = Mid(name, 1, 3)
Select Case bit
Case "CIS"
sheet.Tab.Color = 16776960
Case "NAS"
'etc etc
End Select
End If
Next
This should do the trick. First you need to count all the sheets and then run through each of them and check for the first 3 letters. If this is true you can color it:
For i = 1 To Sheets.Count
If Left(Sheets(i).Name, 3) = "CIS" Then
Sheets(i).Tab.Color = RGB(0, 255, 255)
End If
If Left(Sheets(i).Name, 3) = "NAS" Then
Sheets(i).Tab.Color = RGB(66, 134, 244)
End If
Next i
So I am trying to run the code below. It should be straight to the point, and I don't understand why it's not working. If cell b2 is "John", and cell O2 is empty, then O2 should be red. If O2 is not empty, then it should not be colored.
Any help is must appreciated.
Sub columnO(d As Long)
If Cells(d, "B") = "John" And Cells(d, "O") = "" Then
Cells(d, "O").Interior.Color = RGB(255, 0, 0)
Else
Cells(d, "O").Interior.Color = RGB(1000, 1000, 1000)
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("B10:O10000"), Target) Is Nothing Then
columnO Target.Row
End If
End Sub
This can be easily done with conditional formatting. Just pick conditional formatting from Home menu on your ribbon --> new rule -->Use a formula to determine... and type formula
=$B$2<>"John"
Then you need only set your desired format. You may toggle with $ in formula to allow dragging and copying the format if you need it.
Why don't you rather use conditional formatting instead of VBA?
Might be easier to manage
I have a spreadsheet in which there are ActiveX textboxes that are linked to specific cells. When the number in the cells change, the number in the textbox changes too. Pretty simple.
I wanted the numbers in these textboxes to be red when there is a number above zero and white when the number is zero. I've chosen white so that the zeros can't be seen at all on the printed page. I have a very basic macro that does this:
Sub textbox_change()
Worksheets("PAGE01").E21.LinkedCell = "PAGE01!AB23"
If Worksheets("PAGE01").E21.Value > 0 Then
Worksheets("PAGE01").E21.ForeColor = RGB(255, 0, 0)
Else
Worksheets("PAGE01").E21.ForeColor = RGB(255, 255, 255)
End If
Worksheets("PAGE01").E22.LinkedCell = "PAGE01!AB24"
If Worksheets("PAGE01").E22.Value > 0 Then
Worksheets("PAGE01").E22.ForeColor = RGB(255, 0, 0)
Else
Worksheets("PAGE01").E22.ForeColor = RGB(255, 255, 255)
End If
End Sub
As you can see, the code for each textbox is completed one at a time. How can I combine these so that the macro changes these colors at once, without having to have a block of code for each textbox?
Note: I've only used two textboxes in the example, but I would like to have up to 48 of these boxes total. That would be A LOT of redundancy when I'm positive that there's a much shorter way to take care of these pesky color changes.
Can you kind folks help out? Very much appreciated...
You can loop over the sheet's OLEObjects collection and check for textboxes:
Sub Tester()
Dim t
For Each t In Worksheets("PAGE01").OLEObjects
'is it a textbox ?
If t.progID = "Forms.TextBox.1" Then
'check the name begins with "E"
If t.Name Like "E*" Then
'Set the forecolor: using the built-in color constants,
' but you could instead use specific RGB() values
t.Object.ForeColor = IIf(t.Object.Value > 0, vbRed, vbWhite)
End If
End If
Next t
End Sub
I am quite new to Excel and so far it has been fun learning it. I have started using Excel for modelling and i have gained enough expertise at it
I now wanted to go a step ahead and do a bit of designing on Excel
I have a specific requirement. I have 10 sheets in my workbook. I want to add some sort of animation on my first sheet. I currently have a button on my sheet 1.
On click of button it unhides all the 9 sheets and allows me to see modelling stuff in them. On clicking one more time it hides all the 9 sheets again.
Now i want to add one more thing to this.
On clicking the button i want a light bulb on the sheet to turn on and display a message (along with unhiding the sheets)
On clicking one more time i want the light bulb to turn off and hide the sheets again,
Can someone help me with this animation.
Thanks,
Sachi
Like I said it is very simple. This is how your Button and Bulb looks like.
Shapes used to create the bulb
Straight Connector
Oval
Cloud
Code
Private Sub CommandButton1_Click()
If CommandButton1.Caption = "Hide" Then
'
'~~> Your code here to Hide the Sheets
'
ActiveSheet.Shapes("Oval 2").Fill.ForeColor.RGB = RGB(255, 255, 255)
CommandButton1.Caption = "Unhide"
ElseIf CommandButton1.Caption = "Unhide" Then
'
'~~> Your code here to Unhide the Sheets
'
ActiveSheet.Shapes("Oval 2").Fill.ForeColor.RGB = RGB(255, 255, 0)
CommandButton1.Caption = "Hide"
End If
End Sub
To simply make the button change a shapes fill to yellow try this:
ActiveSheet.Shapes("SHAPE NAME").Fill.ForeColor.RGB = RGB(255, 255, 0)
The same idea can be applied to change the fill back. I've been playing with actual animation myself a lot lately too, so if you want to get something a bit more fun than the above than try something like the following. (Create a shape called Oval 1 to demo it with, or change the name to your shapes name)
Sub bulb()
steps = 300
timelimit = 0.005
increments = 255 / steps
counter = 0
r = 0
g = 0
Do
DoEvents
counter = counter + 1
r = r + increments
g = g + increments
ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = RGB(r, g, 0)
timeout (timelimit)
Loop Until counter = steps
End Sub
Sub timeout(duration_ms As Double)
Start_Time = Timer
Do
DoEvents
Loop Until (Timer - Start_Time) >= duration_ms
End Sub
Will need tweaking to your needs of course but the possibilities playing with this are endless.
In recorded VBA macros, it seems that their formulas use R1C1 reference style. For instance, to fill in B4 with B2+1:
Range("B4").Select
ActiveCell.FormulaR1C1 = "=R[-2]C+1"
Does anyone know if it is possible to switch off this mode? For instance, let recorded macro look like:
Range("B4").Select
ActiveCell.Formula = "=B2+1"
I believe you cannot do that. The macro will always record in R1C1 style.
You can always switch the style but it will only be applied to the worksheet and if you record a macro it will still show R1C1 reference style.
It is very easy to understand the R1C1 style
In R1C1 reference style, the range is referred by how far the cells are located from the cell you are calling. For example, if you have 5 values from R1C1 to R5C1 and the range is called from R7C2, then the range would be R[-6]C[-1]:R[-2]C[-1]. Here the first cell in the range is 6 rows before the cell R7C2 and 1 column before the cell R7C2 and similarly for the last cell in the range.
If I take your example then "=R[-2]C+1" means that the formula is referring to a row which is two rows up (-2) and in the same column (0). Your formula is same as "=R[-2]C[0]+1"
EDIT
Here is a small function that I wrote which can help you convert R1C1 to A1 string
Sub Sample()
'~~> This will give you $B$2
Debug.Print R1C12A1("B4", "R[-2]C")
'~~> This will give you E227
Debug.Print R1C12A1("O9", "R[218]C[-10]", True)
'~~> This will give you $Y$217
Debug.Print R1C12A1("O9", "R[208]C[10]")
End Sub
Function R1C12A1(baseCell As String, sRC As String, Optional RemDollar As Boolean = False) As String
Dim MyArray() As String
Dim r As Long, c As Long
sRC = Replace(sRC, "R", "")
If Left(sRC, 1) = "C" Then
r = 0
Else
r = Replace(Replace(Split(sRC, "C")(0), "[", ""), "]", "")
End If
If Right(sRC, 1) = "C" Then
c = 0
Else
c = Replace(Replace(Split(sRC, "C")(1), "[", ""), "]", "")
End If
If RemDollar = False Then
R1C12A1 = Range(baseCell).Offset(r, c).Address
Else
R1C12A1 = Replace(Range(baseCell).Offset(r, c).Address, "$", "")
End If
End Function
Note: I have not done any error handling here. I am sure you can incorporate that if needed.
There used to be a facility to toggle relative reference when recording a macro.
When you have started recording, in the macro toolbar - near the stop button - there was a button to toggle relative reference; is this not the same as toggling R1C1 ? or isn't this available anymore?
I never bothered toggling it myself as like Siddharth says the R1C1 isn't too tricky to understand plus, irrespective of whatever you do, the VBA will need some editing so at the same time if you wish to use other syntax it's easy enough to change.
I've just played around with the following but it doesn't seem to help so maybe I'm mixing up the use of this button with R1C1...