Quote:
Originally Posted by Seeker2025
Good day to everyone!
I am looking for a VBA code that will apply to certain cells based on their value.
I want to create a job pickup time tracker for three shifts in each sheet each day, each with different operators, and upon the duration of the job and the region that many cells to be highlighted.
Example1
Operator-1 picks a 1-hour duration job, and the job is from the UK region
The value I enter is 1-UK1234 were
1 is the 1-hour duration of the job
UK - Is the UK region code
1234 - Is the Job ID which is not standard
Then four cells to be highlighted considering each cell a 15-minute duration.
I have also attached the template and given sample data in this and manually highlighted the cells
But I would like to have a VBA code to highlight as many cells depend on the duration and region.
I want green color for the UK region jobs, Blue for the US region jobs, Orange for the AP region jobs, Yellow for Break, and Red for Leave.
Cheers.
|
Seeker,
I have quite a bit of experience with VBA in Word, but just a dabbler with Excel VBA. You will most likely get a much better solution or even suggestions for a better way. Anyway, as I understand your requirement. You have these sheets where you manually enter your code sequences e.g. 2-US1234, .75-UK5679 etc. and you want a macro to apply your color coding. Correct?
If yes, then you will need to make a slight change to your codes. L for leave is fine as it is all day. However your coding for BR needs to be changed from .5BR, 1BR etc. to .5-BR, 1-BR to match the separator used for US, UK and AP. If you can do that, then this a macro may work for you:
Copy all of the code to a standard module. Run Color Code Sheets. If you don't like the colors applied the replace the *###### part in the varCodes to the number of the color you like.
Code:
Dim oSheet As Worksheet
Dim varCodes, varCats, varColors
Sub ColorCodeSheets()
Dim lngIndex As Long
varCodes = Split("US*15985347|UK*5296274|BR*65535|AP*12439801|L*6908415", "|")
For Each oSheet In ThisWorkbook.Sheets
For lngIndex = 0 To UBound(varCodes)
FindCat varCodes(lngIndex)
Next
Exit For
Next
lbl_Exit:
Exit Sub
End Sub
Function FindCat(strCode)
Dim oRng As Range
Dim strAddr As String
Dim strCat As String, lngColor As Long
strCat = Split(strCode, "*")(0)
lngColor = CLng(Split(strCode, "*")(1))
With oSheet.UsedRange
Set oRng = .Find(What:=strCat, LookIn:=xlValues)
ProcessFind oRng, lngColor
strAddr = oRng.Address
If Not oRng Is Nothing Then
On Error GoTo Err_GetOut
Do
Set oRng = .FindNext(oRng)
ProcessFind oRng, lngColor
Loop While Not oRng Is Nothing And oRng.Address <> strAddr
End If
End With
Err_GetOut:
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
Set oRng = Nothing
lbl_Exit:
Exit Function
End Function
Sub ProcessFind(oRng As Range, lngColor As Long)
Dim varParts
Dim lngLen As Long
varParts = Split(oRng.Value, "-")
If UBound(varParts) = 1 Then
lngLen = varParts(0) / 0.25
Else
lngLen = 32
End If
oRng.Resize(1, lngLen).Interior.Color = lngColor
lbl_Exit:
Exit Sub
End Sub