so I have a work sheet that was put together by someone here a long time ago. I realized I have 2 tweaks I want to do specifically for this file, hopefully some can help me out, and if all goes well ill like to merge another file to work with this. but let's focus on this first.
my table runs from A2 to L2, my headers are in row 2, and my data info starts at row 3
So on sheet 1, i currently have it set up if a value is inputted in column I, that row turns red. if a value is inputted in column J, that row turns green, and if a value is inputted in column K, that row turns yellow.( I want to keep this setup, but change the yellow to red)
what I have now is if column I has any value, and column J is empty, and column K has any value the row turns yellow and copies to sheet 2 if those conditions are met
what I want to change is basically the color from yellow to red, I'm guessing the row can stay red and still copy to sheet 2
my 2nd tweak is if column I and J have any values in their cells, the row will stay green(of course) but will continue to stay green if I input any value to column K and will then copy to sheet 3 if those conditions are met.
I tried playing with the formulas but I gave up. so here is my coding
Sheet 1
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' Use Mouse Left Double-Click to Sort Ascending on Any Header Title
' AND
' in Column Date Delivered ... it deletes data in 4 last Columns I to L
If Target.Column > 12 Then Exit Sub
If Target.Row = 2 Then
Select Case Target.Column
Case 1
Application.Run ("CustomSort")
Case 9 ' Red
Call SortByColour1(Target)
Case 10 ' Green
Call SortByColour2(Target)
Case 11 ' Yellow
Call SortByColour3(Target)
Case 12 ' Blue
Call SortByColour4(Target)
Case Else
Call StandardSort(Target)
End Select
Else
' Whenever Column A (i.e. #1) - sheet Bins # is Double-Clicked '''''''''
If Target.Column <> 1 Then Cancel = True: Exit Sub
Dim x As Long: x = Target.Row
' Clear Contents in Columns B to L
Range(Cells(x, 2), Cells(x, 12)).ClearContents
' Delete Interior Color
Range(Cells(x, 1), Cells(x, 12)).Interior.Color = xlNone
End If
Cancel = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Objective of this Event Macro :
' to copy and auto-populate the next available row in Outstanding Bins sheet
' ONLY if date delivered (Column K) AND date collected (Column I) are filled BUT NO date paid (Column J) ...
' For the Overweight Fee (Column L), if filled, it will auto-fill the next available row in overweight sheet.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Target.CountLarge > 1 Then Exit Sub
If Target.Column > 12 Then Exit Sub
Dim lRow As Long, j As Long
Dim x As Long: x = Target.Row
Dim y As Long: y = Target.Column
' Deal with Exceptions : If input is deleted from any of the Last 4 Columns ...
' Interior Color for Entire Row MUST be re-adjusted ....
' To be aligned with Conditional Formatting rule ....
' Revert Font Color from White to Black
If y > 8 And IsEmpty(Target) Then
With Range(Cells(x, 1), Cells(x, 12))
.Font.Color = vbBlack
.Font.Bold = False
For j = 9 To 12
If Not IsEmpty(Cells(x, j)) Then
.Interior.Color = Cells(2, j).Interior.Color
Exit For
Else
.Interior.Color = xlNone
End If
Next j
End With
Exit Sub
End If
' Standard Process
Select Case y
Case 4
' Add Sales Tax 13% for Non-Cash Payments
If Target <> "Cash" Then Target.Offset(0, -1) = Target.Offset(0, -1) * 1.13
Case 6
' Add $25 for each Extra Day
If Target >= 1 Then Target.Offset(0, -3) = Target.Offset(0, -3) + (25 * Target.Value)
Case 9, 10
'
Range(Cells(x, 1), Cells(x, 12)).Interior.Color = Cells(2, y).Interior.Color
Case 11
' Outstanding Bins
Range(Cells(x, 1), Cells(x, 12)).Interior.Color = Cells(2, y).Interior.Color
With Sheets("Outstanding Bins")
lRow = .Columns(1).Find("*", After:=Cells(1), LookIn:=xlValues, SearchDirection:=xlPrevious).Row + 1
' No Date Paid and Yes Date Delivered
If Target.Offset(, -1) = "" And IsDate(Target.Offset(0, -2)) Then
Range(Cells(x, 1), Cells(x, 12)).Copy Destination:=.Range("A" & lRow)
End If
Target.Activate
End With
' Completed Jobs
Range(Cells(x, 1), Cells(x, 12)).Interior.Color = Cells(2, y).Interior.Color
With Sheets("Completed Jobs")
lRow = .Columns(1).Find("*", After:=Cells(1), LookIn:=xlValues, SearchDirection:=xlPrevious).Row + 1
' Yes Date Paid and Yes Date Delivered
If Target.Offset(0, -1) Then
Range(Cells(x, 1), Cells(x, 12)).Copy Destination:=.Range("A" & lRow)
End If
Target.Activate
End With
End Select
End Sub
Display More