How to insert a row along with the format of above row by double clicking on specific cell?

user_14641383 0
Viewed 226

I created a table with some formulas, one of these formula is in "column S" that whenever the user double click any cell in "column S", hide the data and re-click to unhide. What I need is a formula when double click any cell in "column G", a new row inserted below that row, taking into account the same format of the above cell.

The problem the both code under same name (Worksheet_BeforeDoubleClick), once I apply the formula for adding new row, the formula for hide/unhide columns stops working, as well as the hide/unhide formula in "Column S" not copied to the new inserted row. For example, I entered a new row (row number 26) in "column G".

Hide/Unhide Code

Private Sub Worksheet_BeforeDoubleClick1(ByVal Target As Range, Cancel As Boolean)
Dim hideColumns As Range
If (Not Intersect(Target, Range("S:S")) Is Nothing) And (Target.Count = 1) Then
    Set hideColumns = Range("T:AI")
    hideColumns.EntireColumn.Hidden = Not hideColumns.EntireColumn.Hidden
    Cancel = True
    End If
End Sub

Insert new Row Code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
Cancel = True
If Intersect(Target, [G7:G90]) Is Nothing Then Exit Sub
Target.Offset(1).EntireRow.Insert
Target.EntireRow.Copy Target.Offset(1).EntireRow
On Error Resume Next
Target.Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents

Target.Offset(1).EntireRow.FormatConditions.Delete

Application.ScreenUpdating = True
End Sub

Here is the link for excel file: https://1drv.ms/x/s!Av2jQlwHZCT3gjJhYEG93xmaW7F6?e=UATO6d

vba excel
1 Answers

As @SJR pointed out, you need to combine the 2 procedures into the same sub. The code below should give you what you're looking for. Let me know how it goes.

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
Dim formRow As Range, pasteRow As Range
On Error GoTo GetOut
Application.EnableEvents = False

If Not Intersect(Me.Range("S:S"), Target) Is Nothing Then
    If Columns("T:AI").Hidden = True Then
        Columns("T:AI").Hidden = False
        cancel = True
        Else
        Columns("T:AI").Hidden = True
        cancel = True
    End If
End If

If Not Intersect(Me.Range("G7:G90"), Target) Is Nothing Then
    Target.Offset(1).EntireRow.Insert Shift:=xlDown
    Target.EntireRow.Copy
    Target.Offset(1, -6).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    Target.Select
    cancel = True
End If

Continue:
    Application.EnableEvents = True
    Exit Sub
GetOut:
    MsgBox Err.Description
    Resume Continue
End Sub
Admin1
Related