Reputation: 69
I have three columns, one of them having all the staff list IDs, the second is having Front-Line staff IDs, The third is having the Back-office staff IDs, sometimes we change the task to some of them, to work in the different field, So His Staff ID has to disappear from Front-Line col and appear in Back-Office col instead. and Vice-Versa, and this will be done by selecting some of Column A staff, then it will loop through Col B and remove selection value(If found), then add these selected cells to Col B.
The same when we normalize, we select some staff from Col A, It should remove the staff IDs from Col B and add it to col C
All Staff | Front-line | Back-Office
15348 | 15348 | 15344
15347 | 15347 | 15345
15345 |
15344 |
What I've achieved so far.
Excuse me if my codes looks a little bit complex, that's the only way I know.
Dedicate Button (Dedicating 1st Col staffs to work as Back-office)
Dim found As Boolean
Dim i, j, mycount, dedlist As Integer
Dim firstempty As Long
With Sheets("StaffList")
firstempty = .Range("H" & .Rows.Count).End(xlUp).Row + 1
dedlist = .Range("L" & .Rows.Count).End(xlUp).Row
End With
mycount = firstempty - 1
found = False
Selection.Copy
With Sheets("StaffList")
firstempty = .Range("H" & .Rows.Count).End(xlUp).Row + 1
Cells(firstempty, 8).Select
Cells(firstempty, 8).PasteSpecial Paste:=xlPasteValues
End With
With Sheets("StaffList")
firstempty = .Range("H" & .Rows.Count).End(xlUp).Row + 1
dedlist = .Range("L" & .Rows.Count).End(xlUp).Row
End With
mycount = firstempty - 1
For i = 2 To mycount
For j = 2 To dedlist
With Sheets("StaffList")
If .Range("H" & i).Value = .Range("L" & j).Value Then
found = True
End If
End With
Next j
If found = False Then
dedlist = dedlist + 1
With Sheets("StaffList")
.Range("L" & dedlist).Value = .Range("H" & i).Value
End With
End If
found = False
Next i
' ActiveSheet.Range("$H$1:$H$500").RemoveDuplicates Columns:=1, Header:=xlYes
Range("A1").Select
Normalize Button (Normalizing 2nd Col staffs to get back working as Front-Line)
Dim CompareRange As Variant, x As Variant, y As Variant
Dim rng As Range
Dim found As Boolean
Dim i, j, mycount, dedlist As Integer
Dim firstempty As Long
With Sheets("StaffList")
firstempty = .Range("M" & .Rows.Count).End(xlUp).Row + 1
dedlist = .Range("H" & .Rows.Count).End(xlUp).Row
End With
mycount = firstempty - 1
found = False
Selection.Copy
With Sheets("StaffList")
firstempty = .Range("M" & .Rows.Count).End(xlUp).Row + 1
Cells(firstempty, 13).Select
Cells(firstempty, 13).PasteSpecial Paste:=xlPasteValues
End With
With Sheets("StaffList")
firstempty = .Range("M" & .Rows.Count).End(xlUp).Row + 1
dedlist = .Range("H" & .Rows.Count).End(xlUp).Row
End With
mycount = firstempty - 1
For i = 2 To mycount
For j = 2 To dedlist
With Sheets("StaffList")
If .Range("M" & i).Value = .Range("L" & j).Value Then
.Range("H" & j).Value = ""
End If
End With
Next j
Next i
Range("A1").Select
Upvotes: 1
Views: 260
Reputation: 10715
This is the VBA implementation of the suggestion in comment:
Option Explicit
Public Sub UpdateStaffTasks()
Const FRNT = "Front-line", BACK = "Back-Office"
Dim selRow As Variant, lrSelRow As Long, ws As Worksheet, i As Long, j As Long
Dim usdRng As Variant, lrUsdRng As Long, red As Long, blu As Long
If Selection.Cells.Count = 1 And Selection.Row = 1 Then Exit Sub
Set ws = Selection.Parent
selRow = GetSelRows(Selection): lrSelRow = UBound(selRow): red = RGB(256, 222, 222)
usdRng = ws.UsedRange: lrUsdRng = UBound(usdRng): blu = RGB(222, 222, 256)
For i = 0 To lrSelRow
For j = i + 2 To lrUsdRng
If j = Val(selRow(i)) Then
If Len(usdRng(j, 1)) > 0 And Len(usdRng(j, 2)) > 0 Then
usdRng(j, 2) = IIf(usdRng(j, 2) = FRNT, BACK, FRNT)
With ws.Cells(j, 1).Resize(, 2).Interior
.Color = IIf(usdRng(j, 2) = FRNT, red, blu)
End With
Exit For
End If
End If
Next
Next
Selection.Parent.UsedRange = usdRng
End Sub
Public Function GetSelRows(ByRef selectedRange As Range) As Variant
Dim s As Variant, a As Range, r As Range, result As Variant
If selectedRange.Cells.Count > 1 Then
For Each a In selectedRange.Areas
For Each r In a.Rows
If r.Row > 1 And InStr(s, r.Row) = 0 Then s = s & r.Row & " "
Next
Next
GetSelRows = Split(RTrim$(s)): Exit Function
Else
GetSelRows = Array(selectedRange.Row): Exit Function
End If
End Function
Before and After:
Upvotes: 1