Diwnload:
https://www.dropbox.com/s/bc2i4p98zs5zrf7/To_do_list.xlsm?dl=0
Private Sub AddButton_Click()
Application.ScreenUpdating = False
Rows("5:5").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("5:5").RowHeight = 15
Range("A5:E5").Font.Bold = False
Range("C5") = Date
Range("D5") = "ongoing"
With Range("E5")
.HorizontalAlignment = xlLeft
End With
Range("E5").WrapText = True
Application.ScreenUpdating = True
End Sub
Private Sub DoneButton_Click()
Application.ScreenUpdating = False
Call Inserter("done", 4, 2)
Application.ScreenUpdating = True
End Sub
Private Sub SuspendBtn_Click()
Dim CurrentRow As Integer
Application.ScreenUpdating = False
Call Inserter("suspended", 4, 1)
Application.ScreenUpdating = True
End Sub
Sub Inserter(ByVal str As String, ByVal FRnum As Integer, ByVal Color As Integer)
Dim RowNum As Integer
RowNum = ActiveCell.Row
Dim StrFRNumber As String
StrFRNumber = "D" & FRnum & ":D" & FRnum
Dim ColNum As Integer
Dim LastCol As Integer
If Range(StrFRNumber) = Empty Then
MsgBox "Select an event to be moved as """ & str & """"
Exit Sub
Else
LastRow = Range(StrFRNumber).End(xlDown).Row
LastCol = Range(StrFRNumber).End(xlToRight).Column
Dim i As Integer
For i = 1 To LastRow
If Range("C" & i).Value = "----" Then
LastRow = i + 1
Exit For
End If
Next i
End If
If RowNum < FRnum + 1 Then
MsgBox "Select an event to be moved as """ & str & """"
Exit Sub
ElseIf RowNum >= LastRow - 1 Then
MsgBox "Select an event to be moved as """ & str & """"
Exit Sub
ElseIf ActiveCell.Column > LastCol Then
MsgBox "Select an event to be moved as """ & str & """"
Exit Sub
End If
Range("D" & RowNum) = str
Dim RangeToBeMoved As String
RangeToBeMoved = "A" & RowNum & ":" & "E" & RowNum
If Color = 1 Then
With Range(RangeToBeMoved).Interior
.Color = 65535
.TintAndShade = 0
End With
ElseIf Color = 2 Then
With Range(RangeToBeMoved).Interior
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
End If
Dim RowNum2 As String
RowNum2 = RowNum & ":" & RowNum
Rows(RowNum2).Cut
Dim RangeLast As String
RangeLast = LastRow & ":" & LastRow
Rows(RangeLast).Insert Shift:=xlDown
Range("A1").Select
End Sub
