Excel VBA auto update Macro - Stack Overflow

admin管理员组

文章数量:1302970

I'm building a sales pipeline of sorts. I have a column that I'm tracking win/loss for, and I would like the column to automatically move to the bottom when I type "Win" and "Loss". I would also like it to have all the Wins sitting on top of the Bottoms.

Problem is I can't get the macro to work.

The column is K. Header for the table is row 7, so data starts in row 8. Right now it's 350 lines long, but will get longer in the future. I only want it to put Win and Loss to the bottom and leave blank untouched. And I would ideally like it to update as I enter the data.

Can someone help me achieve this?

There are some things I've tried, like manipulating this below:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r As Long

    If Target.CountLarge > 1 Then Exit Sub
    
'   See if cell just updated is in column D, if not exit sub
    If Target.Column <> 4 Then Exit Sub
    
'   See if cell just updated set to "Closed"
    If Target.Value = "Closed" Then
        r = Target.Row
'       Move to end
        Application.EnableEvents = False
        Rows(r).Cut
        Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
        Rows(r).Delete
        Application.EnableEvents = True
    End If

End Sub

I cannot get this to work.

I'm building a sales pipeline of sorts. I have a column that I'm tracking win/loss for, and I would like the column to automatically move to the bottom when I type "Win" and "Loss". I would also like it to have all the Wins sitting on top of the Bottoms.

Problem is I can't get the macro to work.

The column is K. Header for the table is row 7, so data starts in row 8. Right now it's 350 lines long, but will get longer in the future. I only want it to put Win and Loss to the bottom and leave blank untouched. And I would ideally like it to update as I enter the data.

Can someone help me achieve this?

There are some things I've tried, like manipulating this below:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r As Long

    If Target.CountLarge > 1 Then Exit Sub
    
'   See if cell just updated is in column D, if not exit sub
    If Target.Column <> 4 Then Exit Sub
    
'   See if cell just updated set to "Closed"
    If Target.Value = "Closed" Then
        r = Target.Row
'       Move to end
        Application.EnableEvents = False
        Rows(r).Cut
        Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
        Rows(r).Delete
        Application.EnableEvents = True
    End If

End Sub

I cannot get this to work.

• excel
• vba

Share Follow edited Feb 10 at 22:39 jonrsharpe 122k3030 gold badges267267 silver badges474474 bronze badges asked Feb 10 at 22:19 99nda99nda 911 bronze badge

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 0

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 4 Then Exit Sub
    
    On Error GoTo exitSub
    
    Dim rngTo As Range
    Set rngTo = Me.Cells(Rows.Count, "A").End(xlUp).Offset(1)

    Select Case UCase(Target.Value)
        Case "WIN"
           ' scan up to top of loss rows
           Do While UCase(rngTo.Offset(-1, 3)) = "LOSS"
              Set rngTo = rngTo.Offset(-1)
           Loop
        Case "LOSS"
        Case Else
           Exit Sub
    End Select
       
    Application.EnableEvents = False
    With Target
        .EntireRow.Cut
        rngTo.Insert Shift:=xlDown
    End With
    Application.CutCopyMode = False
      
exitSub:
    Application.EnableEvents = True
End Sub

本文标签： Excel VBA auto update MacroStack Overflow