Mohamed Hussien
Mohamed Hussien

Reputation: 69

Excel VBA replace selection with blank value

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

Answers (1)

paul bica
paul bica

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:

Before After

Upvotes: 1

Related Questions