Click on cell to open item for editing

[Aussiebear]

I'm looking for code to allow a user to add further detail to an expense amount. In the attached workbook I've provided an example whereby if a user clicks on cell C3 it adds a new line below with the outstanding balance entered directly below the initial figure. Once all the amended data is entered, the user clicks on cell C3 again to close the line up. Any ideas?

[Simon Lloyd]

Ted, forgive me but i've not had time to look at your worksheet, you could use the before right click event like this:
Private s As Long
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If s = 0 Then
Target.Insert shift:=xlDown
s = 1
ElseIf s = 1 Then
Target = Target.Offset(1, 0).Value
Target.Offset(1, 0).Delete shift:=xlUp
s = 0
End If
End SubCurrently this will insert a cell AT your target on right click, make a change to the "pushed down" value, right click your cell again and the value moves up, there could be many implications in moving the cell but its just one idea, or you could use the worksheet change making sure it only activates on target If Target.Address<> "$C$3" Then Exit Sub.....just a couple of ideas!

[mdmackillop]

Consider inserting the formula =sum($D$3:$D3) whenever a new item is inserted. This should cater for your breakdown. I would also think about a helper column which could be used with AutoFilter to show your data.
Selection Change event could also be used to provide a quick access to the detail.

[Bob Phillips]

Here is another crack



Option Explicit

Private PrevValue As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const WS_CHANGE As String = "C:C"
Const WS_AMOUNTS As String = "D:D"
Dim NextRow As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_CHANGE)) Is Nothing Then

With Target

If .Offset(0, -1).Value <> "" Then

If .Offset(1, 0).Value <> "" Or Application.CountBlank(.Offset(1, 0).EntireRow) = Me.Columns.Count Then

.Offset(1, 0).EntireRow.Insert
.Offset(1, 1).Value = .Offset(0, 1).Value
.Offset(1, 1).Font.ColorIndex = 3
End If
End If
End With
ElseIf Not Intersect(Target, Me.Range(WS_AMOUNTS)) Is Nothing Then

PrevValue = Target.Value
End If

ws_exit:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_AMOUNTS As String = "D:D"
Const WS_ENTRY As String = "=INDEX($D$1:D<row>,MAX(IF($B$1:B<row><>"""",ROW($B$1:B<row>))))"
Const WS_TOTAL As String = "=SUM(INDEX(D1:D<row>,MAX(IF(B1:B<prow><>"""",ROW(B1:B<prow>)+1))):D<row>)"
Dim EntryAmt As Double
Dim RunTotal As Double
Dim NextRow As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_AMOUNTS)) Is Nothing Then

With Target

If .Font.ColorIndex = 3 Then

EntryAmt = Me.Evaluate(Replace(WS_ENTRY, _
"<row>", .ROW))
RunTotal = Me.Evaluate(Replace(Replace(WS_TOTAL, _
"<row>", .ROW), _
"<prow>", .ROW - 1))
If RunTotal > EntryAmt Then

MsgBox "Invalid amt"
.Value = PrevValue
ElseIf RunTotal < EntryAmt Then

.Offset(1, 0).EntireRow.Insert
.Offset(1, 0).Value = EntryAmt - RunTotal
.Offset(1, 0).Font.ColorIndex = 3
.Font.ColorIndex = xlColorIndexAutomatic
End If
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

[Bob Phillips]

Small correction to allow changing of previous items



Option Explicit

Private PrevValue As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const WS_CHANGE As String = "C:C"
Const WS_AMOUNTS As String = "D:D"
Dim NextRow As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_CHANGE)) Is Nothing Then

With Target

If .Offset(0, -1).Value <> "" Then

If .Offset(1, -1).Value <> "" Or Application.CountBlank(.Offset(1, 0).EntireRow) = Me.Columns.Count Then

.Offset(1, 0).EntireRow.Insert
.Offset(1, 1).Value = .Offset(0, 1).Value
.Offset(1, 1).Font.ColorIndex = 3
End If
End If
End With
ElseIf Not Intersect(Target, Me.Range(WS_AMOUNTS)) Is Nothing Then

PrevValue = Target.Value
End If

ws_exit:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_AMOUNTS As String = "D:D"
Const WS_ENTRY As String = "=INDEX($D$1:D<row>,MAX(IF($B$1:B<row><>"""",ROW($B$1:B<row>))))"
Const WS_TOTAL As String = "=SUM(INDEX(D1:D<row>,MAX(IF(B1:B<prow><>"""",ROW(B1:B<prow>)+1))):D<row>)"
Dim EntryAmt As Double
Dim RunTotal As Double
Dim NextRow As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_AMOUNTS)) Is Nothing Then

With Target

If .Font.ColorIndex = 3 Then

EntryAmt = Me.Evaluate(Replace(WS_ENTRY, _
"<row>", .ROW))
RunTotal = Me.Evaluate(Replace(Replace(WS_TOTAL, _
"<row>", .ROW), _
"<prow>", .ROW - 1))
If RunTotal > EntryAmt Then

MsgBox "Invalid amt"
.Value = PrevValue
ElseIf RunTotal < EntryAmt Then

.Offset(1, 0).EntireRow.Insert
.Offset(1, 0).Value = EntryAmt - RunTotal
.Offset(1, 0).Font.ColorIndex = 3
.Font.ColorIndex = xlColorIndexAutomatic
End If
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

[mikerickson]

you might want to look at this.
Double click on cells in Column C of Sheet2
to close the details, double click on cell C in the non-detail row for that entry

[Aussiebear]

Thanks for your code Bob, but it does not close the subsection up again.

[Aussiebear]

Thanks for your example Mike, it doesn't quite fit the bill just yet. I don't actually need the date to be repeated or the Payee: detail comments. Will play around with the code provided. Back in 16 days time.