Press a cell and then create cells with specific formula

U

Unexpc

Active Member
Joined
Nov 12, 2020
Messages
496
Office Version
  1. 2019
Platform
  1. Windows
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...
 

Attachments

  • Screenshot 2021-03-27 180521.png
    Screenshot 2021-03-27 180521.png
    7 KB · Views: 18
  • Screenshot 2021-03-27 180524.png
    Screenshot 2021-03-27 180524.png
    11.6 KB · Views: 16
Sort by date Sort by votes
maabadi said:
Another sheets isn't problem.
Another code, if it's worksheet change event also, maybe.
1. Take backup
2. Delete customer names except 2 first for each sheet.
2. Then Test code.
Click to expand...
i test, hyperlink and drag and fill is work, but still not show input name window for i insert write a name
and for another code, this code for work and paper
VBA Code: 
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
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Worksheet Chane event for other sheets not Problem.
1. How you input Customer name at inputBox appears? Select Cell or Input Name manually?
2. Give Example for Customer Name ALso?
 
Upvote 0
maabadi said:
Worksheet Chane event for other sheets not Problem.
1. How you input Customer name at inputBox appears? Select Cell or Input Name manually?
2. Give Example for Customer Name ALso?
Click to expand...
in my workbook input box not show, i say your file Book1 is show input box and with that, i try give name and this work correctly
 
Upvote 0
you think input box show at start (not any customer in list and just new customer in first cell) and for ideal insert specific formula at start (i say generally, but if can't i insert this) is help?
 
Upvote 0
Without Any Customer,You should see InputBox ,but you have Problem with fomulas should be added other Columns?
I work on Formula Method for you also?
 
Last edited:
Upvote 0
maabadi said:
Without Any Customer,You should see InputBox ,but you have Problem with fomulas should be added other Columns?
I work on Formula Method for you also?
Click to expand...
no, my problem just not see inputbox, i said (you think input box show at start (not any customer in list and just new customer in first cell) and for ideal insert specific formula at start (i say generally, but if can't i insert this) is help?) for a suggestion not a problem
my suggestion : without any customer, when i select new customer, show inputbox and i give a name, after that insert specific formula in next cells
 
Upvote 0
1. First At VBA window Go to View and Select Immediate window to See it at Right-down section.
2. Write on it this code exactly
VBA Code: 
? Application.EnableEvents
if its result False , then this is cause of not running code.
Add this code to immediate window and test your code again after that
VBA Code: 
Application.EnableEvents = True

if you want Run code Without any customer At Dashboard, you have two option.
1. you have some customer name at WORK & PAPER Sheet
Try This code:
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long, j As Long, Lr1 As Long, Lr2 As Long, Cr1 As Long, Cr1R As String, Cr2 As Long, Cr2R As String
Dim Lr3 As Long, Lr4 As Long, M1 As Long, M2 As Long, Cr3 As Variant
Lr1 = Range("I" & Rows.Count).End(xlUp).Row
Lr2 = 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 Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("I" & Lr1 & ":M" & Lr1).Insert Shift:=xlDown
     M1 = Application.WorksheetFunction.Match(Range("I" & Lr1 - 1).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
     For i = M1 + 2 To Lr3
     If Sheets("Work").Range("A" & i).Interior.Color = 4697456 Then
     If Sheets("Work").Range("A" & i).Value = "New Customer" Then
     'Range("I" & Lr1 & ":M" & Lr1).Delete Shift:=xlUp
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Range("I" & Lr1 & ":M" & Lr1).Delete Shift:=xlUp
     Application.EnableEvents = True
     Exit Sub
     Else
     Sheets("Work").Range("A" & i & ":G" & i + 3).Copy Sheets("Work").Range("A" & i + 4 & ":G" & i + 7)
     Sheets("Work").Range("A" & i).Value = Cr3
     End If
     Range("I" & Lr1).Value = Sheets("Work").Range("A" & i).Value
     Else
     Range("I" & Lr1).Value = Sheets("Work").Range("A" & i).Value
     End If
     Cr1 = i
     GoTo Resum1
     End If
     Next i
Resum1:
     
     Cr1R = Range("A" & Cr1).Address
     
If Lr1 = 3 Then
     Range("J" & Lr1).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
     ElseIf Lr1 > 3 Then
     Range("J" & Lr1 - 1 & ":J" & Lr1).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & Lr1 - 1 & ":K" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & Lr1 - 1 & ":L" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
     
     End If
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & Lr1), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & Lr1).Value
     Application.EnableEvents = True
   End If
  End If
    If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("N" & Lr2 & ":Q" & Lr2).Insert Shift:=xlDown
     M2 = Application.WorksheetFunction.Match(Range("N" & Lr2 - 1).Value, Sheets("Paper").Range("A1:A" & Lr4), 0)
     For i = M2 + 2 To Lr4
     If Sheets("Paper").Range("A" & i).Interior.Color = 12874308 Then
     If Sheets("Paper").Range("A" & i).Value = "New Customer" Then
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Range("N" & Lr2 & ":Q" & Lr2).Delete Shift:=xlUp
     Application.EnableEvents = True
     Exit Sub
     Else
     Sheets("Paper").Range("A" & i & ":G" & i + 3).Copy Sheets("Paper").Range("A" & i + 4 & ":G" & i + 7)
     Sheets("Paper").Range("A" & i).Value = Cr3
     End If
     Range("N" & Lr2).Value = Sheets("Paper").Range("A" & i).Value
     Else
     Range("N" & Lr2).Value = Sheets("Paper").Range("A" & i).Value
     End If
     Cr2 = i
     GoTo Resum2
     End If
     Next i
Resum2:
      Cr2R = Range("A" & Cr2).Address
     
If Lr2 = 3 Then
     Range("O" & Lr2).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     ElseIf Lr2 > 3 Then
     Range("O" & Lr2 - 1 & ":O" & Lr2).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & Lr2 - 1 & ":P" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & Lr2 - 1 & ":Q" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     End If
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & Lr2), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr2R, TextToDisplay:=Range("N" & Lr2).Value
    Application.EnableEvents = True
   End If
  End If
End Sub

2. You havenot any customer name at Dashboard & also WORK and PAPER Sheet. (only have New Customer at all Sheet)
Try this:
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long, j As Long, Lr1 As Long, Lr2 As Long, Cr1 As Long, Cr1R As String, Cr2 As Long, Cr2R As String
Dim Lr3 As Long, Lr4 As Long, M1 As Long, M2 As Long, Cr3 As Variant
Lr1 = Range("I" & Rows.Count).End(xlUp).Row
Lr2 = 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, Union(Range("I" & Lr1), Range("N" & Lr2))) Is Nothing Then Exit Sub
   If Target.Count > 1 Then Exit Sub
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
     Application.EnableEvents = False
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Application.EnableEvents = True
     Exit Sub
     Else
     Range("I" & Lr1 & ":M" & Lr1).Insert Shift:=xlDown
     i = Application.WorksheetFunction.Match(Cr3, Sheets("Work").Range("A1:A" & Lr3), 0)
     If i = False Then
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3), 0)
     Sheets("Work").Range("A" & i & ":G" & i + 3).Copy Sheets("Work").Range("A" & i + 4 & ":G" & i + 7)
     Sheets("Work").Range("A" & i).Value = Cr3
     End If
     End If
     Range("I" & Lr1).Value = Sheets("Work").Range("A" & i).Value
     If Lr1 = 3 Then
     Range("J" & Lr1).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
     ElseIf Lr1 > 3 Then
     Range("J" & Lr1 - 1 & ":J" & Lr1).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & Lr1 - 1 & ":K" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & Lr1 - 1 & ":L" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
     
     End If

     Cr1R = Range("A" & i).Address
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & Lr1), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & Lr1).Value
     Application.EnableEvents = True
   
  End If
    If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then
    If Target.Count = 1 Then
    Application.EnableEvents = False
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Application.EnableEvents = True
     Exit Sub
     Else
     Range("N" & Lr2 & ":Q" & Lr2).Insert Shift:=xlDown
     i = Application.WorksheetFunction.Match(Cr3, Sheets("Paper").Range("A1:A" & Lr4), 0)
     If i = False Then
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4), 0)
     Sheets("Paper").Range("A" & i & ":G" & i + 3).Copy Sheets("Paper").Range("A" & i + 4 & ":G" & i + 7)
     Sheets("Paper").Range("A" & i).Value = Cr3
     End If
     End If
     Range("N" & Lr2).Value = Sheets("Paper").Range("A" & i).Value
     If Lr2 = 3 Then
     Range("O" & Lr2).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     ElseIf Lr2 > 3 Then
     Range("O" & Lr2 - 1 & ":O" & Lr2).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & Lr2 - 1 & ":P" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & Lr2 - 1 & ":Q" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     End If
      Cr2R = Range("A" & i).Address
      Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & Lr2), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr2R, TextToDisplay:=Range("N" & Lr2).Value
    Application.EnableEvents = True
   End If
  End If
End Sub
 
Upvote 0
maabadi said:
1. First At VBA window Go to View and Select Immediate window to See it at Right-down section.
2. Write on it this code exactly
VBA Code: 
? Application.EnableEvents
if its result False , then this is cause of not running code.
Add this code to immediate window and test your code again after that
VBA Code: 
Application.EnableEvents = True

if you want Run code Without any customer At Dashboard, you have two option.
1. you have some customer name at WORK & PAPER Sheet
Try This code:
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long, j As Long, Lr1 As Long, Lr2 As Long, Cr1 As Long, Cr1R As String, Cr2 As Long, Cr2R As String
Dim Lr3 As Long, Lr4 As Long, M1 As Long, M2 As Long, Cr3 As Variant
Lr1 = Range("I" & Rows.Count).End(xlUp).Row
Lr2 = 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 Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("I" & Lr1 & ":M" & Lr1).Insert Shift:=xlDown
     M1 = Application.WorksheetFunction.Match(Range("I" & Lr1 - 1).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
     For i = M1 + 2 To Lr3
     If Sheets("Work").Range("A" & i).Interior.Color = 4697456 Then
     If Sheets("Work").Range("A" & i).Value = "New Customer" Then
     'Range("I" & Lr1 & ":M" & Lr1).Delete Shift:=xlUp
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Range("I" & Lr1 & ":M" & Lr1).Delete Shift:=xlUp
     Application.EnableEvents = True
     Exit Sub
     Else
     Sheets("Work").Range("A" & i & ":G" & i + 3).Copy Sheets("Work").Range("A" & i + 4 & ":G" & i + 7)
     Sheets("Work").Range("A" & i).Value = Cr3
     End If
     Range("I" & Lr1).Value = Sheets("Work").Range("A" & i).Value
     Else
     Range("I" & Lr1).Value = Sheets("Work").Range("A" & i).Value
     End If
     Cr1 = i
     GoTo Resum1
     End If
     Next i
Resum1:
   
     Cr1R = Range("A" & Cr1).Address
   
If Lr1 = 3 Then
     Range("J" & Lr1).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
     ElseIf Lr1 > 3 Then
     Range("J" & Lr1 - 1 & ":J" & Lr1).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & Lr1 - 1 & ":K" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & Lr1 - 1 & ":L" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
   
     End If
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & Lr1), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & Lr1).Value
     Application.EnableEvents = True
   End If
  End If
    If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("N" & Lr2 & ":Q" & Lr2).Insert Shift:=xlDown
     M2 = Application.WorksheetFunction.Match(Range("N" & Lr2 - 1).Value, Sheets("Paper").Range("A1:A" & Lr4), 0)
     For i = M2 + 2 To Lr4
     If Sheets("Paper").Range("A" & i).Interior.Color = 12874308 Then
     If Sheets("Paper").Range("A" & i).Value = "New Customer" Then
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Range("N" & Lr2 & ":Q" & Lr2).Delete Shift:=xlUp
     Application.EnableEvents = True
     Exit Sub
     Else
     Sheets("Paper").Range("A" & i & ":G" & i + 3).Copy Sheets("Paper").Range("A" & i + 4 & ":G" & i + 7)
     Sheets("Paper").Range("A" & i).Value = Cr3
     End If
     Range("N" & Lr2).Value = Sheets("Paper").Range("A" & i).Value
     Else
     Range("N" & Lr2).Value = Sheets("Paper").Range("A" & i).Value
     End If
     Cr2 = i
     GoTo Resum2
     End If
     Next i
Resum2:
      Cr2R = Range("A" & Cr2).Address
   
If Lr2 = 3 Then
     Range("O" & Lr2).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     ElseIf Lr2 > 3 Then
     Range("O" & Lr2 - 1 & ":O" & Lr2).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & Lr2 - 1 & ":P" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & Lr2 - 1 & ":Q" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     End If
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & Lr2), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr2R, TextToDisplay:=Range("N" & Lr2).Value
    Application.EnableEvents = True
   End If
  End If
End Sub

2. You havenot any customer name at Dashboard & also WORK and PAPER Sheet. (only have New Customer at all Sheet)
Try this:
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long, j As Long, Lr1 As Long, Lr2 As Long, Cr1 As Long, Cr1R As String, Cr2 As Long, Cr2R As String
Dim Lr3 As Long, Lr4 As Long, M1 As Long, M2 As Long, Cr3 As Variant
Lr1 = Range("I" & Rows.Count).End(xlUp).Row
Lr2 = 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, Union(Range("I" & Lr1), Range("N" & Lr2))) Is Nothing Then Exit Sub
   If Target.Count > 1 Then Exit Sub
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
     Application.EnableEvents = False
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Application.EnableEvents = True
     Exit Sub
     Else
     Range("I" & Lr1 & ":M" & Lr1).Insert Shift:=xlDown
     i = Application.WorksheetFunction.Match(Cr3, Sheets("Work").Range("A1:A" & Lr3), 0)
     If i = False Then
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3), 0)
     Sheets("Work").Range("A" & i & ":G" & i + 3).Copy Sheets("Work").Range("A" & i + 4 & ":G" & i + 7)
     Sheets("Work").Range("A" & i).Value = Cr3
     End If
     End If
     Range("I" & Lr1).Value = Sheets("Work").Range("A" & i).Value
     If Lr1 = 3 Then
     Range("J" & Lr1).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
     ElseIf Lr1 > 3 Then
     Range("J" & Lr1 - 1 & ":J" & Lr1).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & Lr1 - 1 & ":K" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & Lr1 - 1 & ":L" & Lr1).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
   
     End If

     Cr1R = Range("A" & i).Address
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & Lr1), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & Lr1).Value
     Application.EnableEvents = True
 
  End If
    If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then
    If Target.Count = 1 Then
    Application.EnableEvents = False
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Application.EnableEvents = True
     Exit Sub
     Else
     Range("N" & Lr2 & ":Q" & Lr2).Insert Shift:=xlDown
     i = Application.WorksheetFunction.Match(Cr3, Sheets("Paper").Range("A1:A" & Lr4), 0)
     If i = False Then
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4), 0)
     Sheets("Paper").Range("A" & i & ":G" & i + 3).Copy Sheets("Paper").Range("A" & i + 4 & ":G" & i + 7)
     Sheets("Paper").Range("A" & i).Value = Cr3
     End If
     End If
     Range("N" & Lr2).Value = Sheets("Paper").Range("A" & i).Value
     If Lr2 = 3 Then
     Range("O" & Lr2).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     ElseIf Lr2 > 3 Then
     Range("O" & Lr2 - 1 & ":O" & Lr2).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & Lr2 - 1 & ":P" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & Lr2 - 1 & ":Q" & Lr2).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     End If
      Cr2R = Range("A" & i).Address
      Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & Lr2), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr2R, TextToDisplay:=Range("N" & Lr2).Value
    Application.EnableEvents = True
   End If
  End If
End Sub
Click to expand...
Awesome, This is correct :)
can add code that when input a name, after that remove underline and font colored to automatic (or black) and change font?
 
Upvote 0
Add this code after hyperlinks line:
1.
VBA Code: 
Sheets("Dashboard").Range("I" & Lr1).Font.Underline = xlUnderlineStyleNone
Sheets("Dashboard").Range("I" & Lr1).Font.ColorIndex = xlColorIndexAutomatic
2.
VBA Code: 
Sheets("Dashboard").Range("N" & Lr2).Font.Underline = xlUnderlineStyleNone
Sheets("Dashboard").Range("N" & Lr2).Font.ColorIndex = xlColorIndexAutomatic
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question
VBA - add formula to cell when created
Replies
2
Views
293
Golaidron
G
I
  • Question
Copy worksheet but the new worksheet to omit some items
2
Replies
11
Views
438
ipbr21054
I
szita2000
  • Question
Index Match Match from a named table to a range
Replies
1
Views
314
Alex Blakenburg
A
B
  • Question
Copy formula into a cell using vba
2
Replies
11
Views
436
BobtBuilder
B
G
  • Solved
Extract the cells that contains alphanumeric string from the column
Replies
6
Views
366
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,215,059
Messages
6,122,913
Members
449,093
Latest member
dbomb1414

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top