Select and Entire Column for a VBA Multi-selection dropdown/Expand cut and paste option

[griggsa14]

I had reached out previously about getting a code so that based on a selection in row A if it were to be switched to completed that the entire row would be cut and then put into the Completed tab. I wanted to see if I could get this code edited so that the same option for when it is completed was expanded to when the tab in A is Denied, Mistake-Abandoned. I have a tab for each I just need the rows to go to either of the 3 corresponding tabs based on what the drop down in A is put to. Also I was having issues getting my multiselection dropdown that I currently have localized to H2 to be switched to the entire H column. I switched from $h$2 to the H:H option but it wouldn't work. I have the entire column of H with a data validation that has the drop downs but I can only get the multiselection to work when I have it to a specific code. If you could show me how to edit this to all of H that would also be awesome. I posted the current code I have below. Thank you.

[COLOR=#333333][COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Dim R As Range, i As Long[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Set R = Intersect(Range("A:A"), Target)[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]If Not R Is Nothing Then[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]For i = R.Count To 1 Step -1[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]If R(i).Value = "Completed" Then[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Application.EnableEvents = False[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]With R(i).EntireRow[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333].Copy Destination:=Sheets("Completed").Cells(Sheets("Completed").Rows.Count, _[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]"A").End(xlUp).Offset(1, 0)[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333].Delete[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]End With[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]End If[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Next i[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]End If[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Application.EnableEvents = True[/COLOR][/COLOR]




[COLOR=#333333][COLOR=#333333]Dim Oldvalue As String[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Dim Newvalue As String[/COLOR][/COLOR]


[COLOR=#333333][COLOR=#333333]On Error GoTo Exitsub[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]If Target.Address = "$H$2" Then[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]GoTo Exitsub[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Else: If Target.Value = "" Then GoTo Exitsub Else[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Application.EnableEvents = False[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Newvalue = Target.Value[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Application.Undo[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Oldvalue = Target.Value[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]If Oldvalue = "" Then[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Target.Value = Newvalue[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Else[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Target.Value = Oldvalue & ", " & Newvalue[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]End If[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]End If[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]End If[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Application.EnableEvents = True[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Exitsub:[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Application.EnableEvents = True[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]End Sub[/COLOR][/COLOR]

 

[DanteAmor]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim R As Range, i As Long, sh As Worksheet
    
    On Error GoTo Exitsub
    
    Set R = Intersect(Range("A:A"), Target)
    
    Application.EnableEvents = False
    If Not R Is Nothing Then
        For i = R.Count To 1 Step -1
            'If R(i).Value = "Completed" Then
[COLOR=#0000ff]            Select Case R(i).Value[/COLOR]
[COLOR=#0000ff]                Case "Completed":           Set sh = Sheets("Completed")[/COLOR]
[COLOR=#0000ff]                Case "Denied":              Set sh = Sheets("Denied")[/COLOR]
[COLOR=#0000ff]                Case "Mistake-Abandoned":   Set sh = Sheets("Mistake-Abandoned")[/COLOR]
[COLOR=#0000ff]            End Select[/COLOR]
            With R(i).EntireRow
                .Copy sh.Cells(sh.Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Delete
            End With
        Next i
    End If
    Application.EnableEvents = True
    
    Dim Oldvalue As String
    Dim Newvalue As String
    
    'If Target.Address = "$H$2" Then
[COLOR=#0000ff]    If Not Intersect(Target, Range("H:H")) Is Nothing Then[/COLOR]
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        Else
            If Target.Value = "" Then GoTo Exitsub Else
            
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Then
                Target.Value = Newvalue
            Else
                Target.Value = Oldvalue & ", " & Newvalue
            End If
        End If
    End If
    Application.EnableEvents = True
Exitsub:
    Application.EnableEvents = True
End Sub

 

[griggsa14]

This worked perfectly thank you.

 

[DanteAmor]

This worked perfectly thank you.

I'm glad to help you. Thanks for the feedback.

 

[griggsa14]

I know this is a longshot and maybe a big ask but I am curious would you know how to convert this to a google script code for sheets? I haven't worked with sheets much until this new job and just realized you can't just upload anything from excel to sheets and have it work the same.

 

[DanteAmor]

I know this is a longshot and maybe a big ask but I am curious would you know how to convert this to a google script code for sheets? I haven't worked with sheets much until this new job and just realized you can't just upload anything from excel to sheets and have it work the same.

I'm sorry, I do not have a Google sheet, I could not prove it. Hopefully someone will answer or create a new thread, for someone to help you convert it.