im trying to work out a little scheduler in excel to manage my life a little better. I use different cell colors for each event (yellow for work, red for university, etc.). I already have a macro CountColor which counts the occurence of a color in a certain range which works fine (i pretty much copy pasted it from an online solution). I now use the macro to calculate the used time into cells like this:
the cells contain =ColorCount(H5;B2:F15) whereas the interior color of the first argument determines the color to count and the seconds parameter is the range to count the color in. This macro works fine. The last number is just the sum of the above three.
I now however face the problem, that changing the interior color of a cell does not trigger the recalculation of formulars. I created a simple button (not the ActiveX one) and assigned a macro to it:
Public Sub CalcButton_onclick()
Worksheets(1).Range("I13:I16").Calculate
End Sub
but when i click the button (i also tried to recalculate the whole sheet by using Worksheets(1).Calculate) nothing happens. Only when i, for example, change the value int the cell my times get recalculated. My button's macro is definitely executed i tested that by adding Worksheets(1).Cells(20, 20).Value = "Test" after the Calculate call and it changed the value of the given cell properly.
For the purpose of completion, i also add the code of the CountColor macro:
'counts the occurence of the interior color of rColor in rRange
Public Function ColorCount(ByRef rColor As Range, ByRef rRange As Range) As Integer
Dim rCell As Range
Dim lCol As Long
Dim vResult As Integer
vResult = 0
lCol = rColor.Interior.ColorIndex
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = 1 + vResult
End If
Next rCell
ColorCount = vResult
End Function
Im not really sure what the problem is but i believe i may have misinterpreted the Calculate method. I only created the 2 macros above. I appriciate any help!
By the way something meta: is this a proper use of a picture in a question? I could not think of a better way to show what i want my output to look like.
Making your colorcount UDF volatile would help (add Application.Volatile) but as you have discovered changing the color or formatting of a cell does not trigger a recalculation so even a volatile UDF will not recalc just on a color change.
If you make your UDF volatile then Range.Calculate should trigger a recalc in Automatic calc mode.
I found the problem myself.
At first i want to thank everyone for their hints and tips. I would propably have needed them after fixing my initial problem and so i had them fixed in advance :)
My problem actually was apparently, that i wanted to declare my spare time as white color. But actually i had several cells which had "no fill color" after coloring every free cell explicitely white it now works with the button. The solution with Worksheet_Change() method in the sheet code did not work unfortunately because a color change is not evaluated as a change in the sheet. Worksheet_SelectionChange() however did the trick with updating when you click on another cell so i do not need the button anymore.
Related
I've been building a team vacation calendar in Excel (Office 365 version) and I'm using VBA for the first time to automate some calculations and styling.
I've been stuck on the following:
I want to create a function that changes the background color of a cell.
I have four colors to switch between so I'd rather make four functions, one per color.
That function will then be called within different functions when needed.
I don't want to use ColorIndex, but rather a custom color (I can use RGB or the Long value), but I can't get the ColorIndex to work either.
My assumption is that the problem lies with the range but at this point, who knows :D.
The long values of each color are stored within a self-made Enum "OwnColorLong".
Here are some of my tries, every time the result in my Excel sheet (when running as a formula) is "#Value!".
'Function SetBackgroundToRed(RangeToChange As Range)
' Dim ColorIWant As Long
' ColorIWant = OwnColorLong.Red
' RangeToChange.Interior.Color = ColorIWant
'End Function
'Sub SetColorToRed(RangeToChange As Range)
' RangeToChange.Select
' With Selection.Interior
' .ColorIndex = 3
' End With
'End Sub
'
Function SetBackgroundToRed(RangeToChange As Range)
Dim MyRange As Range
Set MyRange = Worksheets("Vacation Calendar").Range("RangeToChange")
MyRange.Select
With Selection.Interior
.ColorIndex = 3
End With
End Function
I'm still a bit confused about when to use a sub or a function, or when to best use a class module. All code is now placed within one module, I'll be writing a Main sub linked to a button and putting all the code in there except for the functions themselves. If there are better practices, feel free to let me know.
This won't work as a UDF called from a worksheet cell. Except for some edge cases, e.g. this, UDFs called from a cell can't modify other cells on the worksheet.
Functions can perform a calculation that returns either a value or text to the cell that they are entered in. Any environmental changes should be made through the use of a Visual Basic subroutine.
Prefer Sub to Function since this does something and doesn't return anything.
"I have four colors to switch between so I'd rather make four functions, one per color" - better to make one function and pass a color parameter.
Private Sub SetColor(ByVal RangeToChange As Range, ByVal Color As Long)
RangeToChange.Interior.Color = Color
End Sub
Called like
SetColor yourRange, OwnColorLong.Red
Second, Sub or Function? If you need an answer from your method, then Function it is. In your case, you need no answer, so it is Sub.
Sub SetBackgroundToRed(RangeToChange As Range)
With RangeToChange.Interior
.ColorIndex = 3
End With
End Sub
I got this to work eventually!
Dim rng As String
rng = "A1"
Range(rng).Interior.Color = OwnColorLong.Red
The problem was not knowing how to pass a range as a variable, I had to use String apparently, not Range.
Thanks everyone for the help!
I'm trying to make a button which on click will print out the value of a cell as a string and not the appearance of the cell itself (if that makes sense) using the .PrintOut method in VBA. That cell is the active cell, whose value I set based on the cell next to it. Here is my code:
Sub Graphic2_Click()
Dim MyNumber as Integer
MyNumber = ActiveCell.Offset(-1, 0) + 1
ActiveCell.Value = MyNumber
ActiveCell.Printout
End Sub
I also tried MyNumber.PrintOut but I get an "Invalid Qualifier" error.
Am I missing out something too simple?
Please, try the next code. It use a temporary 'helper cell' where the format to be pasted (and recuperated after printing out):
Sub Graphic2_Click()
Dim helperCell As Range
With ActiveCell
.value = CLng(Offset(-1, 0)) + 1
Set helperCell = .Offset(1) 'it may be any cell to temporarilly be used
.Copy
helperCell.PasteSpecial xlPasteFormats
.ClearFormats
.PrintOut
helperCell.Copy
.PasteSpecial xlPasteFormats: helperCell.ClearFormats
End With
End Sub
To literally print just the contents of the cell:
Clear number formatting for the specified cell
Autofit column width for that column
Turn off gridlines
Turn off row and column headings
Set print area to the single cell, dismissing any warnings
Print out the active sheet
Each of these are straightforward to do in VBA, and probably straightforward to research on SO anyway.
You may also consider a mechanism to return the changed settings to their initial states afterwards. This would involve pushing (storing) the initial state to a variable or variables first, and popping (restoring) it back afterwards.
Explanation:
The VBA method .PrintOut is something you do to a worksheet, not a cell or its contents. Therefore, to get what you need, you need to set up the worksheet for printing so that the only thing that will appear is the contents of your chosen cell. This is what the above steps do.
For more information about the .PrintOut method, see:
https://learn.microsoft.com/en-us/office/vba/api/excel.sheets.printout
Or, to continue what the OP tried:
You could try something like:
ActiveCell.Formula = Range(ActiveCell.Offset(-1,0)).Value2 + 1
If this does not work, try:
ActiveCell.Formula = Range(ActiveCell.Offset(-1,0).Address).Value2 + 1
Or try these without the + 1 on the end, to verify that the rest of the formula is working the way you want it too. As mentioned, you may get a type mismatch issue causing an error if you don't trap first for whether the referenced cell contains a number.
.Formula in this example is how I am setting the content of the cell, and it can be used even when setting a value not necessarily literally a formula. You could use Value instead if you prefer.
.Value2 is a robust method of extracting the evaluated content of the source cell, as a value instead of as a formula.
The PrintOut method is to print a worksheet, not a range or single cell.
Note: This answer is not tested, as I am not near Excel right now.
Also... it's possible that there could be much simpler ways to do what you are trying to accomplish. Could you provide a bit more detail about the context of what you are trying to do.
Problem
While writing this post, I realized what the issue was and fixed it. However, after spending too much time on this, I still would like to know if this is the best way to go about this.
In a worksheet I'm applying a macro to I have a column where some cells contain text, others contain dates (DD.MM.YYYY). Excel automatically aligns text to the left, dates to the right.
I've run into the problem of sometimes having trailing spaces in this column. So I used a for-loop with TRIM to make sure there are no leading or trailing spaces. It worked, but all dates are now aligned to the left, whereas before they were aligned to the right. When I double click into one of those cells and then select another cell, the date snaps back to the right (which is what I want), even though I haven't done anything to the cell.
Fix
It took me way too long to realize (or read attentively) that TRIM is for strings.
I noticed before running the macro: Dates are automatically aligned to the right, but in the ribbon, in "Alignment", there's no option for horizontal alignment selected. If I do so manually and align the dates to the right and then run the macro, the dates stay to the right.
When checking VarType before running the macro, I get 8 for the cells with text and 7 for the cells with dates, as expected. After running the macro, however, I get 8 (meaning string) for both. After double clicking into a cell with date and deselecting it, VarType is 7 again. In the Excel ribbon it always says that it's a Date (before and after the macro), so Excel seemingly doesn't show me what VBA tells me.
My workaround now is this: Before applying TRIM, my macro checks the VarType of the cell and if it is 7, it does nothing since the trailing spaces only have been a problem where users enter text. (Alternatively, I could align the dates right and let TRIM run over all cells)
This is fine, but is there a better way to do this? Does using TRIM on dates have the potential to screw something up? I'm trying to learn something from this.
Code
For good measure, my sample code, with the fix included.
Sub Test()
Dim ws As Worksheet
Dim searchRng As Range
Dim cell As Variant
Set ws = ActiveSheet
With ws
Set searchRng = .Range("A1:A100")
For Each cell In searchRng
If VarType(cell) = 7 Then
'Date -> Do Nothing
Else
cell.Value = WorksheetFunction.Trim(cell.Value)
End If
Next cell
End With
End Sub
For your question, I have do some testing, and my result is quite different compared to you, is it because excel version?
I have a data in A1 by put spacing in front of the date as below:
By executing the following function, the first typename was string, however after remove the spacing it end up typename date, I think it is not necessary to check the type on your solution?
Sub tt()
Debug.Print TypeName(Sheet1.Range("A1").Value)
Sheet1.Range("A1").Value = Trim(Sheet1.Range("A1").Value)
Debug.Print TypeName(Sheet1.Range("A1").Value)
End Sub
So it mean your code can be simplified on the loop as following and still produce the same result, it doesn't matter it is aligned to right:
For Each cell In searchRng
cell.Value = Trim(cell.Value)
Next cell
After my formulas and macros run, Im looking to highlight the cells in my worksheet that are outputted as a "" (Result of an If Formula).
It is a dynamic range, and I am having difficulty finding a way to change the color of Just the cells with a space. Any ideas would be very helpful.
Dim cell As Variant
For Each cell In Sheets("[Sheet name here]").UsedRange.Columns("U").Cells
If InStr(cell.Value, "") = 0 Then
cell.Interior.ColorIndex = 15
End If
Next cell
End Sub
Then I basically repeated it for column "D", but it takes an unusually long time to complete...
Im thinking i can implement the
=LEN(??)=0 function, but not sure how to do so...
The reason it is running so slow is that you're calling Excel Object for every cell in your range. If column U has 1,000 cells that aren't empty then that is 1,000 calls to the Excel object model.
It is much faster to read the entire range into memory at one time and then process it in memory. This is very easy to do. The code below reads cells A1:A100 but the key difference is that it only calls the Excel Object one time (instead of 100 times).
Dim MyData As Variant
MyData = Range("A1:A100").Value
For your code you would do something like this ...
Dim MyData As Variant
Dim i As Long
MyData = ActiveSheet.UsedRange.Columns("U").Cells.Value
For i = 1 To UBound(MyData)
If (MyData(i, 1) = "") Then
'keep track of which cells need to be colored
End If
Next
If you have a lot of cells that need coloring, you will need to use a "non-contiguous" range selecting in order to perform this with one call to Excel's object model. See this article for more information Using VBA to select non-adjacent range
Thanks all. In this instance, I ended up modifying my formulas to actually generate a space " " instead of a null string, "" as #Scott Craner pointed out.
With a legitimate space, I just achieved the same results using conditional formatting, as #tigeravatar suggested.
Thank you all for the help, I really appreciate it !
Basically, I want to make a code that selects the Excel's cells according to the content.
I found to hard to explain in words, so I uploaded this image.
I want to select with a red border all the lines that contains the check mark. But if one line with the check mark is followed by another with the check mark, just do a big selection. (like I did manually in the image)
Any solution?
Thanks in advance
I know I said otherwise in the comments, but now that I've thought about it some more, this is entirely achievable with conditional formatting.
The idea is you'll set all the borders beforehand and then use conditional formatting to remove the borders that you don't want.
First, set the borders for each row how you want them to appear when there is no checkmark.
When the "Pass" column is "No", you want to remove the left and right border. Set up a conditional format using a formula rule to achieve this. Make sure to lock column D because the formula is being applied to multiple columns and you always want to look at column D.
If the current row has "Yes" in the pass column and the row below it also has "Yes", you want to remove the bottom border. You can use an additional conditional format to do this.
You'll need to cover a few more cases with additional conditional formulas, but this is the general idea.
My approach would be this: First write a sub that puts a red border around the outside of any range. It should look something like this:
Sub ApplyBorder(inputRg as Range)
Call inputRg.BorderAround(Weight:=xlMedium, Color:=vbRed)
End Sub
Now we can iterate through our range. If we find a check, include it in the range to be given a border. If we find an x, then apply the red border around the range we have, and reset it to nothing.
Sub FormatTable()
Dim AllTable As Range, oneRedRg As Range, oneRow As Range
Dim iRow As Integer
Set AllTable = GetTable
For iRow = 1 To AllTable.Rows.Count
Set oneRow = AllTable.Rows(iRow)
If oneRow.Cells(1, 3) = True Then
If oneRedRg Is Nothing Then 'if our current redRg is unset,
Set oneRedRg = oneRow 'then this is the first one, so set it
Else
Set oneRedRg = Range(oneRedRg, oneRow) 'if it is already set, then expand oneRedRg to include this one
End If
Else
if Not oneRedRg Is Nothing Then Call ApplyBorder(oneRedRg) 'if we find a range that need not be red, then
Set oneRedRg = Nothing 'apply the border to our redRg and reset it to nothing
End If
Next iRow
If Not oneRedRg Is Nothing Then Call ApplyBorder(oneRedRg) 'this last line captures a group of reds
'that are at the end of the table.
End Sub
I have excluded the "GetTable" function. In my answer, GetTable returns the entire table to be iterated through, without the headers. Also note that I changed the checks and x's to be values "True" or "False" in the spreadsheet for ease.
Happy Coding!
CF with these four rules may serve, where what is not visible is the code point for the ticks (maybe '252'):
and the ranges adjusted, if necessary, to suit.