VBA Move Row by Cell Data

[LE102024]

Hello!

I'm trying to get a VBA code to work where Excel detects if a date value is present in column M in Sheet1 and, if so, copies the entire row to the next blank row in Sheet2. Then Excel should delete that row from Sheet 1.

Column M will be dates in short format (mm/dd/yyyy). I need the entire row to move from Sheet1 (ows or ActiveSheet) to Sheet2 (nws). I have additional codes running that cannot be interrupted, and formatting should be kept as well. I would also like Sheet2 to sort the moved row automatically by the date in column M if possible, else I can command Sheet2 to sort manually.

The codes I've tried don't populate errors, they just don't affect any change to either worksheet.

Any help either getting a procedure started and functioning would be massively appreciated! I'm in a new role at this company and need to get quite a few processes streamlined...

Thanks!

 

[kevin9999]

When you say "where Excel detects if a date value is present...", what date? How is it determined, where is it to be found? The rest of what you ask for is relatively simple to achieve.

 

[LE102024]

When you say "where Excel detects if a date value is present...", what date? How is it determined, where is it to be found? The rest of what you ask for is relatively simple to achieve.

The worksheet user would enter the date manually from an external source. It would not populate within the report automatically or be imported from the external source directly.

The procedure would need to recognize the format of the cell value as a date and run based on that.

 

[LE102024]

The worksheet user would enter the date manually from an external source. It would not populate within the report automatically or be imported from the external source directly.

The procedure would need to recognize the format of the cell value as a date and run based on that.

If it helps, the only value that would ever be entered in that column would be a date (for my worksheet, that column is M). The code wouldn't need to differentiate between different values, just recognize that there's a value there and move the entire row from Sheet1 to Sheet2.

 

[Joe4]

What is the structure of these two sheets?
Do they have a header/title row?
Does the first row of data begin on row 2 of both sheets?
How many columns of data are there, exactly?

 

[Joe4]

If my assumptions are correct, and both sheets have a title in row 1 and the data begins on row 2, the following code should do exactly what you want.
This MUST be placed in the "ows" sheet module in VBA in order to work automatically.
If you are not sure where that is exactly, go to the ows sheet, right-click on the Sheet tab name at the bottom of the screen, select "View Code", and paste this code in the VB Editor window that pops up:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    Dim r As Long
    Dim nr As Long
    Dim nws As Worksheet
    
'   Check for any changes in column M
    Set rng = Intersect(Target, Range("M:M"))
    
'   Exit if no updates to column M
    If rng Is Nothing Then Exit Sub
    
'   Temporarily disable events while making changes to sheet
    Application.EnableEvents = False
    
'   Set new sheet object
    Set nws = Sheets("nws")
    
'   Loop through cells updated in column M
    For Each cell In rng
'       Get row number of cell updated
        r = cell.Row
'       See if after row 1 and is a date
        If r > 1 Then
            If IsDate(cell.Value) Then
'               Find new row on destination sheet to paste to
                nr = nws.Cells(nws.Rows.Count, "M").End(xlUp).Row + 1
'               Move entire row to bottom of "nws" sheet
                Rows(r).Cut nws.Cells(nr, "A")
'               Delete original row
                Rows(r).Delete
            End If
        End If
    Next cell
    
'   Re-sort "nws" Sheet
    With nws.Range("A1").CurrentRegion
        .Sort key1:=nws.Range("M1"), order1:=xlAscending, _
            key2:=nws.Range("A1"), order2:=xlAscending, Header:=xlYes
    End With
    
'   Re-enable events on sheet
    Application.EnableEvents = True

End Sub

Now, as you enter dates in column M on this "ows" sheet, it will move them to the "nws" sheet and sort the "nws" sheet.

 

[LE102024]

Code did not work. No error, but also no result.

 

[MARK858]

Code did not work. No error, but also no result.

Then really you should post a sample of your data preferably with the boards XL2BB addin

what does the formula below return when you change the M2 to the cell reference of one of the cells containing a "date"?

=ISNUMBER(M2)

 

[Joe4]

Code did not work. No error, but also no result.

That probably means that either:
- the values you are entering in really are not dates
- you placed the code in the wrong module or made some changes to my code (or VBA is not enabled)
- you interrupted the code part way through, so it disabled events and did not turn them back on.
- there is some other detail you are not telling us that is affecting things

Here is another version of the code that will do the following:

- Pop-up a message box ANYTIME any cell on your "ows" sheet is manually updated. If you do not get this pop-up when you manually update any cell on the "ows" page, you either:
1. Have VBA disabled
2. Placed this code in the wrong VBA module
3. Changed the name of the procedure (do not did this - it MUST be named as shown to run automatically)
4. Had a code interruption so it disabled events and did not turn them back on.

- Will run anytime ANY value is added to column M (it no longer looks for a date entry, but just any non-blank entry).

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    Dim r As Long
    Dim nr As Long
    Dim nws As Worksheet
    
'***TEMPORARY CODE TO VERIFY CODE IS RUNNING***
    MsgBox "Code is running!"
    
'   Check for any changes in column M
    Set rng = Intersect(Target, Range("M:M"))
    
'   Exit if no updates to column M
    If rng Is Nothing Then Exit Sub
    
'   Temporarily disable events while making changes to sheet
    Application.EnableEvents = False
    
'   Set new sheet object
    Set nws = Sheets("nws")
    
'   Loop through cells updated in column M
    For Each cell In rng
'       Get row number of cell updated
        r = cell.Row
'       See if after row 1 and cell has a value
        If (r > 1) And (cell.Value <> "") Then
'           Find new row on destination sheet to paste to
            nr = nws.Cells(nws.Rows.Count, "M").End(xlUp).Row + 1
'           Move entire row to bottom of "nws" sheet
            Rows(r).Cut nws.Cells(nr, "A")
'           Delete original row
            Rows(r).Delete
        End If
    Next cell
    
'   Re-sort "nws" Sheet
    With nws.Range("A1").CurrentRegion
        .Sort key1:=nws.Range("M1"), order1:=xlAscending, _
            key2:=nws.Range("A1"), order2:=xlAscending, Header:=xlYes
    End With
    
'   Re-enable events on sheet
    Application.EnableEvents = True

End Sub

If the issue is events have become disabled, place this little procedure in any module and manually run it to turn them back on:

Sub ReEnableEvents()
'   Re-enable events on sheet
    Application.EnableEvents = True
End Sub