Need help with simple macro that I'm sure others would find useful!

[rexofspades]

Hi! I'm using Excel 2010 and I have a fairly straightforward issue that I'm trying to solve. Any help would be greatly appreciated! I'm a good programmer but I'm new to VBA, so I don't know enough syntax and it's taking me forever to do what I think should be pretty simple...

I have a To Do List I'm trying to build and I would like items that are "Done" to be first copied to a separate "Done" worksheet and then deleted from the To Do List.

From the "To Do List" worksheet, when a button is activated, it should search column B for a "P" (Wingdings 2 checkmark) and then copy the entire row, switch to the "Dones" worksheet, find the next empty row and copy the data in, thereby appending the list. Then it should delete the entire row completely. For bonus points: I really want TODAY() entered into column I on the "Dones" sheet for the new entries.

I would be so grateful for help!

 

[candybg]

Do you want help learning to write a macro or do you want someone to do it for you? It is fairly easy - you let Excel "watch" (record) what you do, step by step as you do it - then you tell the recorder to stop recording. Then you let it play back and see if you got it right or not. Once the recorder gets it right, you save it.

 

[rexofspades]

Do you want help learning to write a macro or do you want someone to do it for you?

Well to be honest I'd like someone to do it for me.

I'm eager to learn but have to consider workplace time constraints. You can understand the irony of spending too much time creating a to do list to help better manage my time.

 

[rexofspades]

Hi candybg,

The problem with just recording a macro is that I don't see how you'd "record" searching the list for a specific character, then select that row and perform the action of finding the next empty row before pasting.

Thanks!

 

[candybg]

How would you do it, without the Macro?

 

[Trebor76]

Hi rexofspades,

Try this (initially on a copy of your data as the results cannot be undone if they're not as expected):

Option Explicit
Sub Macro1()

    Const lngStartRow As Long = 2 'Starting (static) row number for the data. Change to suit, if necessary.
    
    Dim lngLastRow As Long
    Dim lngPasteRow As Long
    Dim rngMyCell As Range
    Dim rngDelRange As Range
    Dim wsSourceTab As Worksheet
    Dim wsOutputTab As Worksheet
    
    Set wsSourceTab = Sheets("To Do List")
    Set wsOutputTab = Sheets("Done")
    
    lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Application.ScreenUpdating = False
    
    For Each rngMyCell In wsSourceTab.Range("B" & lngStartRow & ":B" & lngLastRow)
        If rngMyCell = "P" Then
            lngPasteRow = wsOutputTab.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            wsSourceTab.Rows(rngMyCell.Row).Copy Destination:=wsOutputTab.Range("A" & lngPasteRow)
            wsOutputTab.Range("I" & lngPasteRow) = Format(Now(), "dd/mm/yyyy") 'Today's date in 'dd/mm/yyyy' format. Change to suit.
            If rngDelRange Is Nothing Then
                Set rngDelRange = wsSourceTab.Cells(rngMyCell.Row, "A")
            Else
                Set rngDelRange = Union(rngDelRange, wsSourceTab.Cells(rngMyCell.Row, "A"))
            End If
        End If
    Next rngMyCell
        
    'If the 'rngDelRange' range has been set, then...
    If Not rngDelRange Is Nothing Then
        '...delete the row(s) from it and inform the user
        rngDelRange.EntireRow.Delete
        MsgBox "All done entries marked with a tick have now been transferred to the """ & wsOutputTab.Name & """ tab.", vbInformation
    'Else...
    Else
        '...inform the user that no rows were deleted as there was no matching criteria in the dataset.
        MsgBox "There were no rows deleted as no there were no matching criteria.", vbExclamation
    End If
    
    Application.ScreenUpdating = True
        
    Set wsSourceTab = Nothing
    Set wsOutputTab = Nothing
        
End Sub

Regards,

Robert

 

[rexofspades]

Robert! You're my hero! That worked very well, with minimal fiddling. (It did break another macro I was using that toggled cells in Column B from "S" to "P", but no matter!)

Only thing that would be helpful: How can I make it so that this line just pastes values?

<code>
wsSourceTab.Rows(rngMyCell.Row).Copy Destination:=wsOutputTab.Range("A" & lngPasteRow)</code>

Also to nit pick, is it possible to have a border be inserted in the same operation here (it erases borders):

<code>
wsOutputTab.Range("I" & lngPasteRow) = Format(Now(), "mm/dd/yy")</code>

Thanks so very much for helping me out.

Best,

Addison

 

[L. Howard]

Try something like this in a standard module.

Howard

Option Explicit

Sub P_Done_Date()

    Dim c As Range
    
   For Each c In Range("B2:B" & Cells(Rows.Count, "A").End(xlUp).Row)
      
      If c.Value = "P" Then
        Range(c.Offset(, -1), c.End(xlToRight)).Copy _
             Sheets("Done").Range("A" & Rows.Count).End(xlUp)(2)
        Range(c.Offset(, -1), c.End(xlToRight)).ClearContents
        c.Offset(, -1) = Date
      End If
      
    Next 'c
    
    Application.CutCopyMode = False

End Sub

 

[Trebor76]

Robert! You're my hero!

You need to aim higher

It did break another macro I was using that toggled cells in Column B from "S" to "P", but no matter!

Switching enable events to off before running the macro and back on after its completion (as I have done with the revised macro below) should resolve this.

Only thing that would be helpful: How can I make it so that this line just pastes values?

This has been coded on the revised macro below.

Also to nit pick, is it possible to have a border be inserted in the same operation here (it erases borders)

This has been coded on the revised macro below.

Regards,

Robert

Option Explicit
Sub Macro1()

    Const lngStartRow As Long = 2 'Starting (static) row number for the data. Change to suit, if necessary.
    
    Dim lngLastRow As Long
    Dim lngPasteRow As Long
    Dim rngMyCell As Range
    Dim rngDelRange As Range
    Dim wsSourceTab As Worksheet
    Dim wsOutputTab As Worksheet
    
    Set wsSourceTab = Sheets("To Do List")
    Set wsOutputTab = Sheets("Done")
    
    lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    For Each rngMyCell In wsSourceTab.Range("B" & lngStartRow & ":B" & lngLastRow)
        If rngMyCell = "P" Then
            lngPasteRow = wsOutputTab.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            wsSourceTab.Rows(rngMyCell.Row).Copy
            wsOutputTab.Rows(lngPasteRow).PasteSpecial xlPasteValues 'http://stackoverflow.com/questions/23937262/excel-vba-copy-paste-values-only-xlpastevalues
            wsOutputTab.Range("I" & lngPasteRow) = Format(Now(), "dd/mm/yyyy") 'Today's date in 'dd/mm/yyyy' format. Change to suit.
            With wsOutputTab.Range("I" & lngPasteRow).Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            If rngDelRange Is Nothing Then
                Set rngDelRange = wsSourceTab.Cells(rngMyCell.Row, "A")
            Else
                Set rngDelRange = Union(rngDelRange, wsSourceTab.Cells(rngMyCell.Row, "A"))
            End If
        End If
    Next rngMyCell
        
    'If the 'rngDelRange' range has been set, then...
    If Not rngDelRange Is Nothing Then
        '...delete the row(s) from it and inform the user
        rngDelRange.EntireRow.Delete
        MsgBox "All done entries marked with a tick have now been transferred to the """ & wsOutputTab.Name & """ tab.", vbInformation
    'Else...
    Else
        '...inform the user that no rows were deleted as there was no matching criteria in the dataset.
        MsgBox "There were no rows deleted as no there were no matching criteria.", vbExclamation
    End If
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
        
    Set wsSourceTab = Nothing
    Set wsOutputTab = Nothing
        
End Sub

 

[rexofspades]

Try something like this in a standard module.

Howard

Option Explicit

Sub P_Done_Date()

    Dim c As Range
    
   For Each c In Range("B2:B" & Cells(Rows.Count, "A").End(xlUp).Row)
      
      If c.Value = "P" Then
        Range(c.Offset(, -1), c.End(xlToRight)).Copy _
             Sheets("Done").Range("A" & Rows.Count).End(xlUp)(2)
        Range(c.Offset(, -1), c.End(xlToRight)).ClearContents
        c.Offset(, -1) = Date
      End If
      
    Next 'c
    
    Application.CutCopyMode = False

End Sub

Hi Howard! Thank you! Is that in lieu of Robert's suggestion? Robert's code worked very well. I'm just now trying to adapt it to paste values.

Thanks!

Addison