I have a spreadsheet that keeps track of project hours. Each project is assigned a color. A row contains half hour increments. Each half hour gets assigned a color based on which project is being worked on during that time.
I want to count the number of changes from one color to another for the length of the row. A row is one day.
How can I do this in Excel?
Below is what a row looks like. Each row is one day. I need to count how many times the color changed in this row left to right. So the output in this case would be 7 because the project changed 7 times.
This is a slightly more condensed UDF:
Function CountColorChanges(rng As Range) As Integer
Dim i As Integer
With rng.Columns
If .Count > 1 Then
For i = 1 To .Count - 1
If rng.Cells(1, i + 1).Interior.Color <> rng.Cells(1, i).Interior.Color Then CountColorChanges = CountColorChanges + 1
Next i
End If
End With
End Function
Option Explicit
Function NumberOfColorChanges(ByVal rng As range)as long
Dim cell As range
Dim color As Long
Dim firstCell As Boolean
firstCell = True
For Each cell In rng
If firstCell = True Then
color = cell.Interior.color
firstCell = False
Else
If color <> cell.Interior.color Then
NumberOfColorChanges = NumberOfColorChanges + 1
color = cell.Interior.color
End If
End If
Next cell
End Function
Related
I am trying to make a sub where the macro counts all the rows containing data (it isn't a set amount, it varies) and then picks a random number between 6 (to exclude headers) and the number of counted rows and highlights the corresponding row. Unfortunately the code I've been working on doesn't do what I need it to do. It does select and highlight a random row, but it selects empty rows too, not only the ones with data. Any ideas where I went wrong?
Sub RandomRow()
Dim mrg As Worksheet
Dim Count As Integer, myRange As Range
Set mrg = ActiveWorkbook.Sheets("Merged")
mrg.Range("A6:K200000").Interior.Color = RGB(255, 255, 255) 'reset cell colours
Set myRange = mrg.Columns("A:A")
Count = Application.WorksheetFunction.CountA(myRange)
myValue = Int((Count * Rnd) + 6) ' Generate random value between 6 and the number of filled rows'.
mrg.Range("A" & myValue).EntireRow.Interior.Color = RGB(255, 255, 153) 'highlight a random row
End Sub
The current value you have for count is misleading. Say it is 20, and the rows extend to 200; you cannot use the value 20 to identify the occupied rows amongst the 200 (unless you created a map/array to store all of the occupied row-numbers, and then choose randomly from these).
You could still determine the CountA if this information is useful to you, but not as part of the random selection process. Better to just find where the last occupied cell is, using End(xlUp).
Now you know the range containing the occupied cells and can choose randomly between these rows. Repeat the generation of a random number until you discover a cell/row that is not empty.
Sub RandomRow()
Dim wsMerged As Worksheet
Dim myRange As Range
Dim count As Long
Dim randRow As Long
Dim occupied As Boolean
Set wsMerged = Worksheets("Merged")
wsMerged.Range("A6:K200000").Interior.Color = RGB(255, 255, 255) 'reset cell colours
Set myRange = wsMerged.Columns("A:A")
'count = Application.WorksheetFunction.CountA(myRange)
count = Range("A200000").End(xlUp).Row - 6
Randomize 'necessary when using Rnd()
Do
randRow = CLng((count * Rnd()) + 6)
'if the cell isn't empty
If wsMerged.Range("A" & randRow).Value <> "" Then
'flag that we are done
occupied = True
wsMerged.Range("A" & randRow).Resize(1, 11).Interior.Color = RGB(255, 255, 153)
End If
Loop While Not occupied
End Sub
To clear cell colours I would set .Interior.ColorIndex = xlColorIndexNone.
At first MyValue is not declared.
Dim MyValue as Long
Now, its better. Secondly, your macro highlight all row, but clear colors only from A to K column. You would rather highlight first 11 columns, wouldn't you?
mrg.Range("A" & myValue).Resize(1, 11).Interior.Color = RGB(255, 255, 153)
And, to answer your question, set myRange like that:
Set myRange = mrg.Range("A6:A200000")
Then your Count worksheet function will not count headings actually. I hope, this helped.
I am trying to create a macro that will find the maximum value (i.e. the largest) for specific columns in row.
Figure 1:
For example, In FIGURE 1 I have shown a simple example table ranging A1 to K12. Where the top 2 rows represent ‘Height’ and ‘Year’ respectively. And they are always in ascending order. The figure shows 2 years data and I am trying to create the maximum for each height between years. I have highlighted in red text what I am trying to do. For example, cell L3 is the Max of B3 and G3 (i.e. =MAX(B3,G3)) and similarly all the cells for range L3:P12 in red are the maximum values for each heights.
I know I can do this easily just by manually calculating using Max(cell1,cell2) function or by using the following Macro:
Sub test()
Range("G1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("L1").Select
ActiveSheet.Paste
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MAX(RC[-10],RC[-5])"
Range("L3").Select
Selection.AutoFill Destination:=Range("L3:P3"), Type:=xlFillDefault
Range("L3:P3").Select
Selection.AutoFill Destination:=Range("L3:P12")
Range("L3:P12").Select
End Sub
But my actual table is far more larger with many more years of data with more heights and I will be running this in a loop for many spreadsheets. There for the number of rows and columns can vary. So I am just wondering how I can adopt a dynamic argument that will dynamically calculate the max based on the top two rows (i.e. height and year).
I was thinking if any way I could set a range for the top row as the height will be always increasing until the next year when it restart from the lowest value again. My plan was to then try to put some conditions to calculate the max values and autofill the range. But I am just not able to even define the range as I am strugling to logically plan this code. The following is what I have tried and I would really appreciate any guidance on how logically I could achieve this problem. Many thanks in Advance!
Sub test()
Dim LR As Long, i As Long, r As Range
LR = Range("1" & Columns.Count).End(xlToRight)
For i = 1 To LR
If Range("1" & i).Value > 10 Then
If r Is Nothing Then
Set r = Range("1" & i)
Else
Set r = Union(r, Range("1" & i))
End If
End If
Next i
r.Select
End Sub
Due to the unlimited possibility of height values, using a class was the best solution that I could think of for now. Hopefully this provides a good foundation to build from.
In a class module named 'HeightClass':
Option Explicit
Dim rngRangeStore As Range
Dim sValueStore As String
Public Property Set rngRange(rngInput)
Set rngRangeStore = rngInput
End Property
Public Property Get rngRange() As Range
Set rngRange = rngRangeStore
End Property
Public Property Let sValue(sInput As String)
sValueStore = sInput
End Property
Public Property Get sValue() As String
sValue = sValueStore
End Property
Then in a standard Module:
Option Explicit
Sub Get_Max()
Dim lRecord As Long, lRange As Long, lLastRecord As Long, lLastColumn As Long
Dim colRanges As New Collection
Dim clsRange As HeightClass
'Find Last used column in the year row
lLastColumn = Rows(2).Find(What:="*", SearchDirection:=xlPrevious).Column
'Find last used row in column 1
lLastRecord = Columns(1).Find(What:="*", SearchDirection:=xlPrevious).Row
For lRange = 2 To lLastColumn
On Error Resume Next
Set clsRange = Nothing
Set clsRange = colRanges(Trim$(Cells(1, lRange).Value))
On Error GoTo 0
If Not clsRange Is Nothing Then
'Add to existing range
Set clsRange.rngRange = Union(clsRange.rngRange, Cells(1, lRange))
Else
'Add range to colletion in order of smallest to largest
Set clsRange = New HeightClass
Set clsRange.rngRange = Cells(1, lRange)
clsRange.sValue = Cells(1, lRange).Value
If colRanges.Count = 0 Then
colRanges.Add Item:=clsRange, Key:=clsRange.sValue
Else
For lRecord = 1 To colRanges.Count
If clsRange.sValue < colRanges(lRecord).sValue Then
colRanges.Add Item:=clsRange, Key:=clsRange.sValue, Before:=colRanges(lRecord).sValue
Exit For
ElseIf lRecord = colRanges.Count Then
colRanges.Add Item:=clsRange, Key:=clsRange.sValue, After:=colRanges(lRecord).sValue
Exit For
End If
Next lRecord
End If
End If
Next lRange
'Place height headers
For lRange = 1 To colRanges.Count
With Cells(1, lLastColumn + lRange)
.Value = colRanges(lRange).sValue
.Font.Color = vbRed
End With
Next lRange
'Process each record
For lRecord = 3 To lLastRecord
For lRange = 1 To colRanges.Count
With Cells(lRecord, lLastColumn + lRange)
.Value = Application.Max(colRanges(lRange).rngRange.Offset(lRecord - 1))
.Font.Color = vbRed
.NumberFormat = "0.00"
End With
Next lRange
Next lRecord
End Sub
This is written to perform the desired process on whatever sheet is in focus.
So the array formula (enter it with Ctrl+Shift+Enter)version would be, in L3 etc.:
=MAX(IF($B$1:$K$1=L$1,$B3:$K3,""))
It says:
look in the headers $B$1:$K$1 to check a match for your column's height (=L$1)
if it matches, take the value ,$B3:$K3
otherwise ignore it ,""
take the MAX of those non-ignored values
I tried this with 100 columns (5 heights * 20 years) and 1000 rows of RAND produced random numbers and the recalculation time was negligible
I need to hide rows in excel based on the value of multiple cells in the same row. If my row contains all 0's or is blank I need it hid. If there is any integer (not 0 or neg) I need the row shown. On the same sheet I have 'section headers' that separate sections, and below that, a row of blanks. Can I leave those intentional blanks in? I've had a few partially working lines written out, I just can't get it all together.
Hope this make sense and thanks for any help!
Edit: Now if I have a hidden column I'd like for the 'sum' to disregard the hidden column. I've tried nesting something inside RowanC's answer but no go.
For Each myRow In hideRange.Rows
For Each cell In hideRange.Cells
If cell.Columns.Hidden = False Then
Total = Total + cell.Value
End If
Next
If Total = 0 Then 'if the sum of the row=0 then hide
myRow.EntireRow.Hidden = True
End If
Next
My quick go at it:
Sub rowHider1()
Dim hideRange As Range
Dim myRow As Range
Set hideRange = Sheets(2).Range("A2:D12") 'you must set this to apply to the range you want (you could use active selection if you wanted)
hideRange.Rows.EntireRow.Hidden = False 'unhide any rows currently hidden
For Each myRow In hideRange.Rows
If Application.WorksheetFunction.Sum(myRow) = 0 Then 'if the sum of the row=0 then hide
myRow.EntireRow.Hidden = True
End If
Next
End Sub
to take this a step further, and if a column is hidden, don't include it in the sum, moving away from worksheetFunction sum:
Sub rowHider()
Dim hideRange As Range
Dim myRow As Range
Dim cell As Range
Dim bob As Double
Set hideRange = Sheets(2).Range("A1:G12") 'you must set this to apply to the range you want (you could use active selection if you wanted)
hideRange.Rows.EntireRow.Hidden = False 'unhide any rows currently hidden
For Each myRow In hideRange.Rows
bob = 0
For Each cell In myRow.Cells()
If cell.EntireColumn.Hidden <> True Then
Debug.Print cell.Address & " " & cell.Value
bob = bob + cell.Value
End If
Next
If bob = 0 Then 'if the sum of the row=0 then hide
myRow.EntireRow.Hidden = True
End If
Next
End Sub
I'm trying to write a macro to change the colors of rows when the values in column B change. Column A will be my controlling column using 1's and 0's, i.e. column A will stay a 1 as long as column B stays the same; whenever B changes, A will flip to a 0, and so on.
I can get it to color the rows correctly when the values in column B change, but the problem arises when I filter the data. For example: let's say I have B2-B4 set to "test1", B5-B7 set to "test2", and B8-B10 set to "test3", then I filter column B to not include "test2". Originally, the rows would be colored differently where the column values changed, but rows B2-B4 and B8-B10 are set to the same color and now they're touching since the "test2" rows are hidden.
Here's the code I used to color the rows, but it doesn't work for filtering:
Sub ColorRows()
Dim This As Long
Dim Previous As Long
Dim LastRow As Long
Dim Color As Integer
Dim R As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
RwColor = Array(15,0)
Color = 0
For R = 2 To LastRow
This = Cells(R, 1).Value
Previous = Cells(R - 1, 1).Value
If This <> Previous Then Color = 1 - Color
Range("A" & R & ":M" & R).Select
Selection.Interior.ColorIndex = RwColor(Color)
Next R
End Sub
How can I fix it so that even after filtering the rows are colored correctly when there is a change in column values?
Here's a way to do this:
1.) Insert the code below as a UDF in a code module.
2.) Then put the formula in A, as A2: =analyseVisible(B2).
This will compare B-cells to the next visible cell above and result in a 'rank'-counter in A.
Now that the counter in A in contiunous (even if rows are hidden), you can use MOD 2 to color it with conditional formatting:
3.) Add a conditional format (from A2 for the whole table): =MOD($A2,2)=1 and set the fill color.
If you use the filter now or change values in B, the rows are re-colored in realtime.
Public Function analyseVisible(r As Range) As Integer
Dim i As Long
If Application.Caller.Row <= 2 Or _
r.Row <> Application.Caller.Row Then
analyseVisible = 1
Exit Function
End If
i = r.Row - 1
While r.Worksheet.Rows(i).Hidden And i > 1
i = i - 1
Wend
If i = 1 Then
analyseVisible = 1
Else
analyseVisible = r.Worksheet.Cells(i, Application.Caller.Column).Value
If r.Worksheet.Cells(i, r.Column).Value <> _
r.Value Then analyseVisible = analyseVisible + 1
End If
End Function
The code below handles the issue by checking only the used & visible rows. It works pretty well, but I was unable to figure out how to fire it when the filter changes. It also does it's comparisons directly on the values that are changing.
Private Sub colorRows()
Dim this As Variant
Dim previous As Variant
Dim currentColor As Long
Dim rng As Range 'visible range
Dim c As Range ' cell
' pick a color to start with
currentColor = vbYellow
' rng = used and visible cells
Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
For Each c In rng ' For each cell that is visible and used
If Not c.Row = 1 Then ' skip header row
this = c.Value
'some simple test logic to switch colors
If this <> previous Then
If currentColor = vbBlue Then
currentColor = vbYellow
ElseIf currentColor = vbYellow Then
currentColor = vbBlue
End If
End If
'set interior color
c.Interior.color = currentColor
previous = this
End If
Next c
End Sub
Then, in the module of the worksheet that you want to colorize, call the sub from the Worksheet_Activate() event. (In reality, you probably want a different event. I mostly work with Access, so I don't really know what's available to you. I'm just trying to point you in the right direction to what I'm sure is your next question if you stick with the method you started with.)
Private Sub Worksheet_Activate()
colorRows
End Sub
I am very new to macros, so this is probably a dumb question. I have searched and searched, and have not yet found the answer, so I hope an expert in here will aid me :)
In my code I have a large range that I search through for a certain trait (all cells have either the values "Done", "Ongoing" or "Waiting"). When I find the value "Ongoing", I want to use that cell to create a smaller range, that I will use a counter in. I can, however, not make the subrange work :(
Dim range1 As Range
For Each cell In Sheet2.Range("A5:Y5")
If cell.Value = "Ongoing" Then Set range1 = Cells(cell.Row, cell.Column)
Next cell
i = 0
For Each cell In Sheet2.Range("A5:range1")
If cell.Value = "Done" Then
i = i + 1
End If
Next cell
Here you have a simple code performing some of the actions you want:
Dim rangeToSearch As Range
Dim doneCount As Integer, onGoingCount As Integer, onGoingDones(50) As Integer
Set rangeToSearch = Sheet2.Range("A5:Y5")
doneCount = 0
onGoingCount = 0
For Each cell In rangeToSearch
If (Not IsEmpty(cell)) Then
If LCase(cell.Value) = "done" Then
doneCount = doneCount + 1
ElseIf LCase(cell.Value) = "ongoing" Then
onGoingCount = onGoingCount + 1
onGoingDones(onGoingCount) = doneCount
doneCount = 0
End If
End If
Next cell
It counts the number of "done" (caps does not matter) between "ongoing" cells and store them in an array (onGoingDones; it can just deal with upto 50 elements, but I guess that is more than enough).