Press a cell and then create cells with specific formula

[Unexpc]

Hi guys
i have sheet that just list of customers, i insert costumers name in one column and other data i want to have in next columns
for name of customers of have this formula : =HYPERLINK("#'Sheet name'!A"&MATCH("Name of Customer",Sheet name!A:A,0),"Name of Customer")
sheet name that is sheet customer that belong data in it, for example for me Work for sheet name
another formula this is in next columns
=IFERROR(INDEX(Sheet name!B:B,MATCH($I4,Sheet name!A:A,0)-2,0),"")
=IFERROR(SUM(INDEX(Sheet name!D:D,MATCH($I3,Sheet name!A:A,0)+1,0):INDEX(Sheet name!E:E,MATCH($I4,Sheet name!A:A,0)-2,0)),"")
=IFERROR(SUM(INDEX(Sheet name!F:F,MATCH($I3,Sheet name!A:A,0)+1,0):INDEX(Sheet name!G:G,MATCH($I4,Sheet name!A:A,0)-2,0)),"")
this 3 formulas drag and fill in next rows
now
i want when select cell after last customer that may write NEW CUSTOMER, create a new first formula with the name that i write and then drag and fill this 3 formulas in that row and still stay this cell NEW CUSTOMER after that...

 

[maabadi]

Sorry my fault.Modify Code For Paper Sheet to This:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long, Lr1 As Long, Lr2 As Long, Cr, Lr3 As Long, Lr4 As Long, K As Long
Application.EnableEvents = False
Lr1 = Sheets("Dashboard").Range("I" & Rows.Count).End(xlUp).Row
Lr2 = Sheets("Dashboard").Range("N" & Rows.Count).End(xlUp).Row
Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next 
If Intersect(Target, Range("A1:A" & Lr4)) Is Nothing Then Exit Sub 
For i = 3 To Lr2 - 1 
Cr = """" & Sheets("Dashboard").Range("N" & i).Value & """"
Sheets("Dashboard").Range("N" & i).Formula = "=HYPERLINK(""#'Paper'!A""&MATCH(" & Cr & ",Paper!" & "A:A" & ",0)," & Cr & ")"
With Sheets("Dashboard").Range("N" & i).Font
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlColorIndexAutomatic
                .Name = "Arial"
                .Size = 14    
End With
Next i
Application.EnableEvents = True
End Sub

 

[Unexpc]

Sorry my fault.Modify Code For Paper Sheet to This:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long, Lr1 As Long, Lr2 As Long, Cr, Lr3 As Long, Lr4 As Long, K As Long
Application.EnableEvents = False
Lr1 = Sheets("Dashboard").Range("I" & Rows.Count).End(xlUp).Row
Lr2 = Sheets("Dashboard").Range("N" & Rows.Count).End(xlUp).Row
Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
If Intersect(Target, Range("A1:A" & Lr4)) Is Nothing Then Exit Sub
For i = 3 To Lr2 - 1
Cr = """" & Sheets("Dashboard").Range("N" & i).Value & """"
Sheets("Dashboard").Range("N" & i).Formula = "=HYPERLINK(""#'Paper'!A""&MATCH(" & Cr & ",Paper!" & "A:A" & ",0)," & Cr & ")"
With Sheets("Dashboard").Range("N" & i).Font
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlColorIndexAutomatic
                .Name = "Arial"
                .Size = 14   
End With
Next i
Application.EnableEvents = True
End Sub

i test but again not find correct hyperlink

 

[maabadi]

Test it on your uploaded file also and see what is result.
Are you have another worksheet event at work & paper sheet?

 

[Unexpc]

Test it on your uploaded file also and see what is result.
Are you have another worksheet event at work & paper sheet?

i think for Sheet and Print

 

[maabadi]

I don't know what is exact problem? please describe more?

 

[Unexpc]

I don't know what is exact problem? please describe more?

when i add row, hyperlink does not work correctly

 

[maabadi]

Add row at work Or Paper Sheet? Or ....

 

[Unexpc]

Add row at work Or Paper Sheet? Or ....

yes add in work and paper, both of them

 

[maabadi]

Test first

 Application.EnableEvents = True

At immediate window at VBA Then Try Codes for both sheets.

 

[Unexpc]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E3:E1048576,G3:G1048576")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value > 0 Then Target = Target.Value * -1
End Sub

i have this code in work and paper too, that is causes any problem?