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: 17
Sort by date Sort by votes
maabadi said:
if you want delete Customer Name on dashboard sheet , I think you can do it with dashboard worksheet change event without modification.
Click to expand...
you mean delete or change customer name, i not try until now but i just change name of that working without any specific work? i test it now and change a customer name in column I but not change that customer name in Work sheet and after i change, not show data about that customer in column K and L in dashboard and hyperlink of this customer not work too
Unexpc said:
2.for delete customer, just select on customer name and i delete this cell and after that, delete all data of that customer in Work or Paper and three cells that belong to that customer in Dashboard, deleted automatically
Click to expand...
and i mean about that is for delete a customer, i should select for example I3,J3,K3,L3 and then delete this cells that can delete customer data in Work sheet, or Paper like this with different range to delete, i mean when just select I3 and delete this, J3 and K3 and L3 delete automatically and delete data about this in Work Sheet and for Paper sheet like this
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
You want Insert/Delete or Edit Customer Names?
At previous post you only speak about insert or delete customer Name not Editing them.
 
Upvote 0
maabadi said:
You want Insert/Delete or Edit Customer Names?
At previous post you only speak about insert or delete customer Name not Editing them.
Click to expand...
actually i want delete customer and i last test about months ago that belong this post and you working on it and this function in a code you send not work, im afraid to do that (delete cell that name of customer in dashboard) and make problem with list since i test a code belong this post and it can't correctly do that and i think still available this problem and for delete customer name i think should remember select 4 cells about customer and delete them, so
maabadi said:
if you want delete Customer Name on dashboard sheet , I think you can do it with dashboard worksheet change event without modification.
Click to expand...
for this post i read you delete customer name, i understand select customer name and when can edit name, in this situation i edit or delete customer name, i don't understand you mean delete CELL customer name and i think you start a new subject, crack it, i misunderstood but edit customer name is good subject to do because for change name of customer i should insert new customer and then replaced data on it ;) however like ever you right and i wrong, but how about 1? this is main problem that make mistakes when i working on last customer that i be careful not write on this 4 source rows sample of insert new customers
 
Upvote 0
I am very, very sorry, i didn't know subject 2 is worked, otherwise i don't ask it again
 
Upvote 0
Unexpc said:
but how about 1?
Click to expand...
I working on it, No problem.
Unexpc said:
I am very, very sorry, i didn't know subject 2 is worked, otherwise i don't ask it again
Click to expand...
No need to hesitate, I am ask because I think you want reverse process at sheets work & Paper that when you delete customer name at them Then I add to code to delete linked name at Dashboard.
 
Upvote 0
Unexpc said:
but how about 1?
Click to expand...
1. I think Best way is transfer New Customer Rows (4 rows) to 10 Rows before End (For me is 1048563-1048566)
2. after changing code try to edit last customer data (after Title) and see code at Work Paper works or Not, if Don't Work, we should change Lr3 and Lr4 Definition at code.
Only Change Code at Dashboard Sheet To this:
VBA Code: 
Private Sub Worksheet_Change(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, M As Long
On Error Resume Next
Lr1 = Range("I" & Rows.Count).End(xlUp).Row + Target.Rows.Count - 1
Lr2 = Range("N" & Rows.Count).End(xlUp).Row + Target.Rows.Count - 1
If Intersect(Target, Union(Range("I3:I" & Lr1), Range("N3:N" & Lr2))) Is Nothing Then Exit Sub
Lr3 = Sheets("Work").Range("A" & Rows.Count - 20).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count - 20).End(xlUp).Row
Application.FindFormat.Clear
Application.EnableEvents = False
If Not Intersect(Target, Range("I3:I" & Lr1)) Is Nothing Then
M = Application.WorksheetFunction.Match(Range("I" & Target.Row - 1), Sheets("Work").Range("A1:A" & Lr3), 0)
If M = 0 Then
M1 = 1
Else
Application.FindFormat.Interior.Color = 4697456
M1 = Sheets("Work").Range("A" & M + 2 & ":A" & Lr3).Find("", , , , , xlNext, , , True).Row
End If
M2 = Application.WorksheetFunction.Match(Range("I" & Target.Row), Sheets("Work").Range("A1:A" & Lr3), 0) - 1
Application.FindFormat.Interior.Color = 14277081
If M2 = 0 Then M2 = Sheets("Work").Range("A" & M1 + 2 & ":A" & Lr3 + 100).Find("", , , , , xlNext, , , True).Row
Sheets("Work").Rows(M1 & ":" & M2).Delete
Sheets("Work").Rows(Lr3 + 100).Resize(M2 - M1 + 1).Insert
    Range("J3:J" & Lr1 - Target.Rows.Count + 1).Formula = "=IFERROR(INDEX(Work!B:B,MATCH($I4,Work!A:A,0)-2,0),"""")"
    Range("K3:K" & Lr1 - Target.Rows.Count + 1).Formula = "=IFERROR(SUM(INDEX(Work!D:D,MATCH($I3,Work!A:A,0)+1,0):INDEX(Work!E:E,MATCH($I4,Work!A:A,0)-2,0)),"""")"
    Range("L3:L" & Lr1 - Target.Rows.Count + 1).Formula = "=IFERROR(SUM(INDEX(Work!F:F,MATCH($I3,Work!A:A,0)+1,0):INDEX(Work!G:G,MATCH($I4,Work!A:A,0)-2,0)),"""")"
For i = Target.Row To Lr1 - Target.Rows.Count + 1
    If i = Lr1 - Target.Rows.Count + 1 Then GoTo Resum4
    Cr1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3), 0)
     Cr1R = Range("A" & Cr1).Address
     Range("I" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & i), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & i).Value
     With Sheets("Dashboard").Range("I" & i)
                .Font.Underline = xlUnderlineStyleNone
                .Font.ColorIndex = xlColorIndexAutomatic
                .Font.Name = "Microsoft Parsi"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

Next i
Resum4:
M2 = Application.WorksheetFunction.Match("New Customer", Sheets("Dashboard").Range("I1:I" & Lr1), 0)
Sheets("Dashboard").Range("J" & M2 & ":L" & M2 + Target.Rows.Count - 1).Delete Shift:=xlUp

End If


If Not Intersect(Target, Range("N3:N" & Lr2)) Is Nothing Then
M = Application.WorksheetFunction.Match(Range("N" & Target.Row - 1), Sheets("Paper").Range("A1:A" & Lr4), 0)
If M = 0 Then
M1 = 1
Else
Application.FindFormat.Interior.Color = 12874308
M1 = Sheets("Paper").Range("A" & M + 2 & ":A" & Lr4).Find("", , , , , xlNext, , , True).Row
End If
M2 = Application.WorksheetFunction.Match(Range("N" & Target.Row), Sheets("Paper").Range("A1:A" & Lr4), 0) - 1
Application.FindFormat.Interior.Color = 14277081
If M2 = 0 Then M2 = Sheets("Paper").Range("A" & M1 + 2 & ":A" & Lr4 + 100).Find("", , , , , xlNext, , , True).Row
Sheets("Paper").Rows(M1 & ":" & M2).Delete
Sheets("Paper").Rows(Lr4 + 100).Resize(M2 - M1 + 1).Insert
    Range("O3:O" & Lr2 - Target.Rows.Count + 1).Formula = "=IFERROR(INDEX(Paper!B:B,MATCH($N4,Paper!A:A,0)-2,0),"""")"
    Range("P3:P" & Lr2 - Target.Rows.Count + 1).Formula = "=IFERROR(SUM(INDEX(Paper!D:D,MATCH($N3,Paper!A:A,0)+1,0):INDEX(Paper!E:E,MATCH($N4,Paper!A:A,0)-2,0)),"""")"
    Range("Q3:Q" & Lr2 - Target.Rows.Count + 1).Formula = "=IFERROR(SUM(INDEX(Paper!F:F,MATCH($N3,Paper!A:A,0)+1,0):INDEX(Paper!G:G,MATCH($N4,Paper!A:A,0)-2,0)),"""")"

For i = Target.Row To Lr2 - Target.Rows.Count + 1
    If i = Lr2 - Target.Rows.Count + 1 Then GoTo Resum5
    Cr1 = Application.WorksheetFunction.Match(Range("N" & i), Sheets("Paper").Range("A1:A" & Lr4), 0)
     Cr1R = Range("A" & Cr1).Address
     Range("N" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & i), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr1R, TextToDisplay:=Range("N" & i).Value
     With Sheets("Dashboard").Range("N" & i)
                .Font.Underline = xlUnderlineStyleNone
                .Font.ColorIndex = xlColorIndexAutomatic
                .Font.Name = "Microsoft Parsi"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

Next i
Resum5:
M2 = Application.WorksheetFunction.Match("New Customer", Sheets("Dashboard").Range("N1:N" & Lr2), 0)
Sheets("Dashboard").Range("O" & M2 & ":Q" & M2 + Target.Rows.Count - 1).Delete Shift:=xlUp

End If
Application.FindFormat.Clear
Application.EnableEvents = True
End Sub

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 - 20).End(xlUp).Row
Lr4 = Sheets("Paper (2)").Range("A" & Rows.Count - 20).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
    Application.EnableEvents = False
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
     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
     Application.FindFormat.Clear
     Application.FindFormat.Interior.Color = 4697456
     i = Sheets("Work").Range("A" & Lr3 + 3 & ":A" & Rows.Count).Find("", , , , , xlNext, , , True).Row
     Sheets("Dashboard").Range("I" & Lr1).Value = Cr3
     Worksheets("Dashboard").Sort.SortFields.Clear
     Range("I2:I" & Lr1).Sort Key1:=Range("I2"), Header:=xlYes, Order1:=xlAscending
     M2 = Application.WorksheetFunction.Match(Cr3, Sheets("Dashboard").Range("I1:I" & Lr1), 0)
     M1 = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & M2 + 1).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
     Application.FindFormat.Interior.Color = 14277081
     If M1 = 0 Then M1 = Sheets("Work").Range("A1:A" & Lr3 + 100).Find("", , , , , xlNext, , , True).Row + 1
     If M1 = 0 Then M1 = 1
     Sheets("Work").Range("A" & i & ":G" & i + 3).Copy
     Sheets("Work").Range("A" & M1 & ":G" & M1).Insert Shift:=xlDown
     Sheets("Work").Range("A" & M1).Value = Cr3
     Sheets("Work").Range("A" & M1).Font.ColorIndex = xlColorIndexAutomatic
     Sheets("Work").Rows(i).Resize(4).Delete
     End If
     End If

    Range("J3:J" & Lr1).Formula = "=IFERROR(INDEX(Work!B:B,MATCH($I4,Work!A:A,0)-2,0),"""")"
    Range("K3:K" & Lr1).Formula = "=IFERROR(SUM(INDEX(Work!D:D,MATCH($I3,Work!A:A,0)+1,0):INDEX(Work!E:E,MATCH($I4,Work!A:A,0)-2,0)),"""")"
    Range("L3:L" & Lr1).Formula = "=IFERROR(SUM(INDEX(Work!F:F,MATCH($I3,Work!A:A,0)+1,0):INDEX(Work!G:G,MATCH($I4,Work!A:A,0)-2,0)),"""")"

   For i = M2 To Lr1
    Cr1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3), 0)
    Cr1R = Range("A" & Cr1).Address
     Range("I" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & i), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & i).Value
     With Sheets("Dashboard").Range("I" & i)
                .Font.Underline = xlUnderlineStyleNone
                .Font.ColorIndex = xlColorIndexAutomatic
                .Font.Name = "Microsoft Parsi"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With
    Next i
     Sheets("Work").Activate
     Sheets("Work").Range("A" & M1).Select
     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
     Application.FindFormat.Clear
     Application.FindFormat.Interior.Color = 4697456
     i = Sheets("Paper").Range("A" & Lr4 + 3 & ":A" & Rows.Count).Find("", , , , , xlNext, , , True).Row
     Sheets("Dashboard").Range("N" & Lr2).Value = Cr3
     Worksheets("Dashboard").Sort.SortFields.Clear
     Range("N2:N" & Lr2).Sort Key1:=Range("N2"), Header:=xlYes, Order1:=xlAscending
     M2 = Application.WorksheetFunction.Match(Cr3, Sheets("Dashboard").Range("N1:N" & Lr2), 0)
     M1 = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("N" & M2 + 1).Value, Sheets("Paper").Range("A1:A" & Lr4), 0)
     Application.FindFormat.Interior.Color = 14277081
     If M1 = 0 Then M1 = Sheets("Paper").Range("A1:A" & Lr4 + 100).Find("", , , , , xlNext, , , True).Row + 1
     If M1 = 0 Then M1 = 1
     Sheets("Paper").Range("A" & i & ":G" & i + 3).Copy
     Sheets("Paper").Range("A" & M1 & ":G" & M1).Insert Shift:=xlDown
     Sheets("Paper").Range("A" & M1).Value = Cr3
     Sheets("Paper").Range("A" & M1).Font.ColorIndex = xlColorIndexAutomatic
     End If
     End If

    Range("O3:O" & Lr2).Formula = "=IFERROR(INDEX(Paper!B:B,MATCH($N4,Paper!A:A,0)-2,0),"""")"
    Range("P3:P" & Lr2).Formula = "=IFERROR(SUM(INDEX(Paper!D:D,MATCH($N3,Paper!A:A,0)+1,0):INDEX(Paper!E:E,MATCH($N4,Paper!A:A,0)-2,0)),"""")"
    Range("Q3:Q" & Lr2).Formula = "=IFERROR(SUM(INDEX(Paper!F:F,MATCH($N3,Paper!A:A,0)+1,0):INDEX(Paper!G:G,MATCH($N4,Paper!A:A,0)-2,0)),"""")"

     For i = M2 To Lr2
      Cr1 = Application.WorksheetFunction.Match(Range("N" & i), Sheets("Paper").Range("A1:A" & Lr4), 0)
     Cr1R = Range("A" & Cr1).Address
     Range("N" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & i), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr1R, TextToDisplay:=Range("N" & i).Value
     With Sheets("Dashboard").Range("N" & i)
                .Font.Underline = xlUnderlineStyleNone
                .Font.ColorIndex = xlColorIndexAutomatic
                .Font.Name = "Microsoft Parsi"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

    Next i
     Sheets("Paper").Activate
     Sheets("Paper").Range("A" & M1).Select
    End If
  End If
  Application.FindFormat.Clear
  Application.EnableEvents = True
End Sub
 
Upvote 0
Try this Modified code:
VBA Code: 
Private Sub Worksheet_Change(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, M As Long
On Error Resume Next
Lr1 = Range("I" & Rows.Count).End(xlUp).Row + Target.Rows.Count - 1
Lr2 = Range("N" & Rows.Count).End(xlUp).Row + Target.Rows.Count - 1
If Intersect(Target, Union(Range("I3:I" & Lr1), Range("N3:N" & Lr2))) Is Nothing Then Exit Sub
Lr3 = Sheets("Work").Range("A" & Rows.Count - 20).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count - 20).End(xlUp).Row
Application.FindFormat.Clear
Application.EnableEvents = False
If Not Intersect(Target, Range("I3:I" & Lr1)) Is Nothing Then
M = Application.WorksheetFunction.Match(Range("I" & Target.Row - 1), Sheets("Work").Range("A1:A" & Lr3), 0)
If M = 0 Then
M1 = 1
Else
Application.FindFormat.Interior.Color = 4697456
M1 = Sheets("Work").Range("A" & M + 2 & ":A" & Lr3).Find("", , , , , xlNext, , , True).Row
End If
M2 = Application.WorksheetFunction.Match(Range("I" & Target.Row), Sheets("Work").Range("A1:A" & Lr3), 0) - 1
Application.FindFormat.Interior.Color = 14277081
If M2 = 0 Then M2 = Sheets("Work").Range("A" & M1 + 2 & ":A" & Lr3 + 100).Find("", , , , , xlNext, , , True).Row
Sheets("Work").Rows(M1 & ":" & M2).Delete
Sheets("Work").Rows(Lr3 + 100).Resize(M2 - M1 + 1).Insert
    Range("J3:J" & Lr1 - Target.Rows.Count + 1).Formula = "=IFERROR(INDEX(Work!B:B,MATCH($I4,Work!A:A,0)-2,0),"""")"
    Range("K3:K" & Lr1 - Target.Rows.Count + 1).Formula = "=IFERROR(SUM(INDEX(Work!D:D,MATCH($I3,Work!A:A,0)+1,0):INDEX(Work!E:E,MATCH($I4,Work!A:A,0)-2,0)),"""")"
    Range("L3:L" & Lr1 - Target.Rows.Count + 1).Formula = "=IFERROR(SUM(INDEX(Work!F:F,MATCH($I3,Work!A:A,0)+1,0):INDEX(Work!G:G,MATCH($I4,Work!A:A,0)-2,0)),"""")"
For i = Target.Row To Lr1 - Target.Rows.Count + 1
    If i = Lr1 - Target.Rows.Count + 1 Then GoTo Resum4
    Cr1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3), 0)
     Cr1R = Range("A" & Cr1).Address
     Range("I" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & i), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & i).Value
     With Sheets("Dashboard").Range("I" & i)
                .Font.Underline = xlUnderlineStyleNone
                .Font.ColorIndex = xlColorIndexAutomatic
                .Font.Name = "Microsoft Parsi"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

Next i
Resum4:
M2 = Application.WorksheetFunction.Match("New Customer", Sheets("Dashboard").Range("I1:I" & Lr1), 0)
Sheets("Dashboard").Range("J" & M2 & ":L" & M2 + Target.Rows.Count - 1).Delete Shift:=xlUp

End If


If Not Intersect(Target, Range("N3:N" & Lr2)) Is Nothing Then
M = Application.WorksheetFunction.Match(Range("N" & Target.Row - 1), Sheets("Paper").Range("A1:A" & Lr4), 0)
If M = 0 Then
M1 = 1
Else
Application.FindFormat.Interior.Color = 12874308
M1 = Sheets("Paper").Range("A" & M + 2 & ":A" & Lr4).Find("", , , , , xlNext, , , True).Row
End If
M2 = Application.WorksheetFunction.Match(Range("N" & Target.Row), Sheets("Paper").Range("A1:A" & Lr4), 0) - 1
Application.FindFormat.Interior.Color = 14277081
If M2 = 0 Then M2 = Sheets("Paper").Range("A" & M1 + 2 & ":A" & Lr4 + 100).Find("", , , , , xlNext, , , True).Row
Sheets("Paper").Rows(M1 & ":" & M2).Delete
Sheets("Paper").Rows(Lr4 + 100).Resize(M2 - M1 + 1).Insert
    Range("O3:O" & Lr2 - Target.Rows.Count + 1).Formula = "=IFERROR(INDEX(Paper!B:B,MATCH($N4,Paper!A:A,0)-2,0),"""")"
    Range("P3:P" & Lr2 - Target.Rows.Count + 1).Formula = "=IFERROR(SUM(INDEX(Paper!D:D,MATCH($N3,Paper!A:A,0)+1,0):INDEX(Paper!E:E,MATCH($N4,Paper!A:A,0)-2,0)),"""")"
    Range("Q3:Q" & Lr2 - Target.Rows.Count + 1).Formula = "=IFERROR(SUM(INDEX(Paper!F:F,MATCH($N3,Paper!A:A,0)+1,0):INDEX(Paper!G:G,MATCH($N4,Paper!A:A,0)-2,0)),"""")"

For i = Target.Row To Lr2 - Target.Rows.Count + 1
    If i = Lr2 - Target.Rows.Count + 1 Then GoTo Resum5
    Cr1 = Application.WorksheetFunction.Match(Range("N" & i), Sheets("Paper").Range("A1:A" & Lr4), 0)
     Cr1R = Range("A" & Cr1).Address
     Range("N" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & i), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr1R, TextToDisplay:=Range("N" & i).Value
     With Sheets("Dashboard").Range("N" & i)
                .Font.Underline = xlUnderlineStyleNone
                .Font.ColorIndex = xlColorIndexAutomatic
                .Font.Name = "Microsoft Parsi"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

Next i
Resum5:
M2 = Application.WorksheetFunction.Match("New Customer", Sheets("Dashboard").Range("N1:N" & Lr2), 0)
Sheets("Dashboard").Range("O" & M2 & ":Q" & M2 + Target.Rows.Count - 1).Delete Shift:=xlUp

End If
Application.FindFormat.Clear
Application.EnableEvents = True
End Sub

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 - 20).End(xlUp).Row
Lr4 = Sheets("Paper (2)").Range("A" & Rows.Count - 20).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
    Application.EnableEvents = False
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
     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
     Application.FindFormat.Clear
     Application.FindFormat.Interior.Color = 4697456
     i = Sheets("Work").Range("A" & Lr3 + 3 & ":A" & Rows.Count).Find("", , , , , xlNext, , , True).Row
     Sheets("Dashboard").Range("I" & Lr1).Value = Cr3
     Worksheets("Dashboard").Sort.SortFields.Clear
     Range("I2:I" & Lr1).Sort Key1:=Range("I2"), Header:=xlYes, Order1:=xlAscending
     M2 = Application.WorksheetFunction.Match(Cr3, Sheets("Dashboard").Range("I1:I" & Lr1), 0)
     M1 = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & M2 + 1).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
     Application.FindFormat.Interior.Color = 14277081
     If M1 = 0 Then M1 = Sheets("Work").Range("A1:A" & Lr3 + 100).Find("", , , , , xlNext, , , True).Row + 1
     If M1 = 0 Then M1 = 1
     Sheets("Work").Range("A" & i & ":G" & i + 3).Copy
     Sheets("Work").Range("A" & M1 & ":G" & M1).Insert Shift:=xlDown
     Sheets("Work").Range("A" & M1).Value = Cr3
     Sheets("Work").Range("A" & M1).Font.ColorIndex = xlColorIndexAutomatic
     Sheets("Work").Rows(i).Resize(4).Delete
     End If
     End If

    Range("J3:J" & Lr1).Formula = "=IFERROR(INDEX(Work!B:B,MATCH($I4,Work!A:A,0)-2,0),"""")"
    Range("K3:K" & Lr1).Formula = "=IFERROR(SUM(INDEX(Work!D:D,MATCH($I3,Work!A:A,0)+1,0):INDEX(Work!E:E,MATCH($I4,Work!A:A,0)-2,0)),"""")"
    Range("L3:L" & Lr1).Formula = "=IFERROR(SUM(INDEX(Work!F:F,MATCH($I3,Work!A:A,0)+1,0):INDEX(Work!G:G,MATCH($I4,Work!A:A,0)-2,0)),"""")"

   For i = M2 To Lr1
    Cr1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3), 0)
    Cr1R = Range("A" & Cr1).Address
     Range("I" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & i), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & i).Value
     With Sheets("Dashboard").Range("I" & i)
                .Font.Underline = xlUnderlineStyleNone
                .Font.ColorIndex = xlColorIndexAutomatic
                .Font.Name = "Microsoft Parsi"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With
    Next i
     Sheets("Work").Activate
     Sheets("Work").Range("A" & M1).Select
     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
     Application.FindFormat.Clear
     Application.FindFormat.Interior.Color = 12874308
     i = Sheets("Paper").Range("A" & Lr4 + 3 & ":A" & Rows.Count).Find("", , , , , xlNext, , , True).Row
     Sheets("Dashboard").Range("N" & Lr2).Value = Cr3
     Worksheets("Dashboard").Sort.SortFields.Clear
     Range("N2:N" & Lr2).Sort Key1:=Range("N2"), Header:=xlYes, Order1:=xlAscending
     M2 = Application.WorksheetFunction.Match(Cr3, Sheets("Dashboard").Range("N1:N" & Lr2), 0)
     M1 = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("N" & M2 + 1).Value, Sheets("Paper").Range("A1:A" & Lr4), 0)
     Application.FindFormat.Interior.Color = 14277081
     If M1 = 0 Then M1 = Sheets("Paper").Range("A1:A" & Lr4 + 100).Find("", , , , , xlNext, , , True).Row + 1
     If M1 = 0 Then M1 = 1
     Sheets("Paper").Range("A" & i & ":G" & i + 3).Copy
     Sheets("Paper").Range("A" & M1 & ":G" & M1).Insert Shift:=xlDown
     Sheets("Paper").Range("A" & M1).Value = Cr3
     Sheets("Paper").Range("A" & M1).Font.ColorIndex = xlColorIndexAutomatic
     End If
     End If

    Range("O3:O" & Lr2).Formula = "=IFERROR(INDEX(Paper!B:B,MATCH($N4,Paper!A:A,0)-2,0),"""")"
    Range("P3:P" & Lr2).Formula = "=IFERROR(SUM(INDEX(Paper!D:D,MATCH($N3,Paper!A:A,0)+1,0):INDEX(Paper!E:E,MATCH($N4,Paper!A:A,0)-2,0)),"""")"
    Range("Q3:Q" & Lr2).Formula = "=IFERROR(SUM(INDEX(Paper!F:F,MATCH($N3,Paper!A:A,0)+1,0):INDEX(Paper!G:G,MATCH($N4,Paper!A:A,0)-2,0)),"""")"

     For i = M2 To Lr2
      Cr1 = Application.WorksheetFunction.Match(Range("N" & i), Sheets("Paper").Range("A1:A" & Lr4), 0)
     Cr1R = Range("A" & Cr1).Address
     Range("N" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & i), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr1R, TextToDisplay:=Range("N" & i).Value
     With Sheets("Dashboard").Range("N" & i)
                .Font.Underline = xlUnderlineStyleNone
                .Font.ColorIndex = xlColorIndexAutomatic
                .Font.Name = "Microsoft Parsi"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

    Next i
     Sheets("Paper").Activate
     Sheets("Paper").Range("A" & M1).Select
    End If
  End If
  Application.FindFormat.Clear
  Application.EnableEvents = True
End Sub
 
Upvote 0
this errors
 

Attachments

  • image_2021-09-26_135812.png
    image_2021-09-26_135812.png
    4.6 KB · Views: 2
  • image_2021-09-26_135819.png
    image_2021-09-26_135819.png
    31.9 KB · Views: 3
Last edited:
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
356
Golaidron
G
T
  • Solved
Adding additional text to a value pulled from another sheet
Replies
8
Views
188
Snakehips
Snakehips
T
  • Solved
MATCH function
2
Replies
14
Views
272
Fluff
Fluff
I
  • Question
Copy worksheet but the new worksheet to omit some items
2
Replies
11
Views
510
ipbr21054
I
szita2000
  • Question
Index Match Match from a named table to a range
Replies
1
Views
408
Alex Blakenburg
A

Forum statistics

Threads
1,216,119
Messages
6,128,947
Members
449,480
Latest member
yesitisasport

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