Hello!
I'm still new to VBA, but using nearly all my brain cells i managed to build the code below.
However, when i execute the macro, Excel seems to be working for ages but accomplishes nothing. I don't receive any error message, but it appears Excel is stuck in an endless loop.
I suspect there's a significant flaw in my code somewhere, but i can't seem to figure out where.
Sub Makro_color_cells()
Application.ScreenUpdating = False
Dim groupfrom As Range
Dim groupto As Range
Dim groupfinal As Range
lastrow = Cells(Rows.Count, "B").End(xlUp).Row
x = 4
t = 0
Do While x < lastrow
Set groupfrom = Cells(x - 1, "F")
Cells(x - 1, "B").Activate
Do While ActiveCell = ActiveCell.Offset(1, 0)
t = t + 1
ActiveCell.Offset(1, 0).Activate
Loop
x = x + t
Set groupto = Cells(x - 1, "F")
Set groupfinal = Range(groupfrom, groupto)
If Not (groupfinal.Find("Storage") Is Nothing) Then
Range("groupfinal").Interior.ColorIndex = 3
End If
t = 0
Set groupfrom = Nothing
Set groupto = Nothing
Set groupfinal = Nothing
Loop
Application.ScreenUpdating = True
End Sub
The purpose of the code is to color some cells in column F based on some criterias:
Column B contains numbers with duplicates placed next to each other. Consider all rows with identical values in column B as a "group".
Now if one or more rows in a "group" has the text "Storage" in column F, then all rows in that "group" should have their F column colored.
The basic idea behind my code is to locate the "group" and using groupfrom
and groupto
to set a range groupfinal
equal to the group's cells in column F.
Then using the range.find
method to test if there's an occurrence of "Storage".
I tried troubleshooting, but with no luck.
Any ideas why the code doesn't work?
I appreciate any help and I'm open to ideas with a different approach than my code.
Thank you in advance!
As all your groups will be grouped together and not mixed, then a vba script can be used to check for the group value, use the total number of that value to define the range and change the cell colours in column F:
Sub Makro_color_cells()
Dim LastRow
Dim CurrentRow
Dim GroupValue
Dim GroupTotal
Dim GroupCheck
GroupValue = Range("B1").Value ' get the first value to search
CurrentRow = 1 ' Define the starting row
With ActiveSheet ' find the last used cell in the column
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
For x = 1 To LastRow ' start the reapat until last cell reached
GroupTotal = Application.WorksheetFunction.CountIf(Range("B1:B" & LastRow), GroupValue) ' search for total of the group values
GroupCheck = Application.WorksheetFunction.CountIf(Range("F" & CurrentRow & ":F" & CurrentRow + GroupTotal - 1), "Storage") ' search for "Storage" in the range from current row to total rows of the same group values
If GroupCheck >= 1 Then ' if the "Storage" search is equal to one or more then colour the range of cells
Range("F" & CurrentRow & ":F" & CurrentRow & ":F" & CurrentRow + GroupTotal - 1).Interior.ColorIndex = 3
End If
CurrentRow = CurrentRow + GroupTotal ' We know how many cells are in the same group so we can bypass them and move the current row to the next group of values
GroupValue = Range("B" & CurrentRow).Value ' Get the value for the new group
If GroupValue = "" Then ' Check the new group value and if it is nothing then we can exit the 'For Next x'
Exit For
End If
Next x
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.