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: 20
  • Screenshot 2021-03-27 180524.png
    Screenshot 2021-03-27 180524.png
    11.6 KB · Views: 19
Sort by date Sort by votes
maabadi said:
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
Click to expand...
i change this code that error (i think for Paper (2)), this a sample for show for what range placed 4 rows and you test on it but main sheet is Paper, for Work like this, this code may working but please see this code, and what about this range 1048573:1048576?
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").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
 
Last edited:
Upvote 0

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Unexpc said:
what about this range 1048573:1048576?
Click to expand...
You cann't do, because if you want insert row, you see problems.
Unexpc said:
and about hide or unhide?
Click to expand...
I prefer this method, because with hide & unhide , maybe you see hided row at print pages., but I don't test it.
Unexpc said:
and about edit customer name, anyway to do that
Click to expand...
For editing customer name, if you want we can add some parts to code, but I think at your previous post , you don't want it.

AND Do you test code with last customer data at work or paper sheets? And Is it working Correctly?
 
Upvote 0
Unexpc said:
and about hide or unhide?
Click to expand...
Try 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).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count).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).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
    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).Hidden = False
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 100), 0)
     Sheets("Work").Rows(i).Resize(4).Hidden = True
     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
     Sheets("Paper").Rows(i).Resize(4).Hidden = False
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4 + 100), 0)
     Sheets("Paper").Rows(i).Resize(4).Hidden = True
     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
maabadi said:
Try 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).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count).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).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
    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).Hidden = False
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 100), 0)
     Sheets("Work").Rows(i).Resize(4).Hidden = True
     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
     Sheets("Paper").Rows(i).Resize(4).Hidden = False
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4 + 100), 0)
     Sheets("Paper").Rows(i).Resize(4).Hidden = True
     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
Click to expand...
i test it, with two customer is ok, but when i insert customer 3, this replaced customer 2 and not work correctly
maabadi said:
For editing customer name, if you want we can add some parts to code, but I think at your previous post , you don't want it.
Click to expand...
no this is very useful to use because before for edit customer name, i should insert new customer and move data
maabadi said:
You cann't do, because if you want insert row, you see problems.
Click to expand...
for now, nothing problems with it? or have limit to insert row? this is very good keep this mind
 
Upvote 0
For use New Customer at Last rows Use Post# 171

For Hiding Try 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).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count).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).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
    Application.EnableEvents = False
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 100), 0)
     Sheets("Work").Rows(i).Resize(4).Hidden = False
     i = 0
     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("A1:A" & Lr3 + 3).Find("", , , , , xlPrevious, , , 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
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 100), 0)
     Sheets("Work").Rows(i).Resize(4).Hidden = True
     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)),"""")"

If M2 < 3 Then M2 = 3
   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
    i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 100), 0)
     Sheets("Work").Rows(i).Resize(4).Hidden = False
     i = 0
      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("A1:A" & Lr4 + 3).Find("", , , , , xlPrevious, , , 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
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4 + 100), 0)
     Sheets("Paper").Rows(i).Resize(4).Hidden = True
     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)),"""")"

If M2 < 3 Then M2 = 3
     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
maabadi said:
For use New Customer at Last rows Use Post# 171

For Hiding Try 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).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count).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).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
    Application.EnableEvents = False
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 100), 0)
     Sheets("Work").Rows(i).Resize(4).Hidden = False
     i = 0
     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("A1:A" & Lr3 + 3).Find("", , , , , xlPrevious, , , 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
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 100), 0)
     Sheets("Work").Rows(i).Resize(4).Hidden = True
     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)),"""")"

If M2 < 3 Then M2 = 3
   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
    i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 100), 0)
     Sheets("Work").Rows(i).Resize(4).Hidden = False
     i = 0
      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("A1:A" & Lr4 + 3).Find("", , , , , xlPrevious, , , 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
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4 + 100), 0)
     Sheets("Paper").Rows(i).Resize(4).Hidden = True
     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)),"""")"

If M2 < 3 Then M2 = 3
     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
Click to expand...
a question, this is hidden last customer?
i want just sample or source rows (specific 4 rows) will be hidden, create customers or anything not hidden just this 4 sample rows hidden, with this code i test when i create a customer that hidden and placed before 4 source rows, that i won't
Unexpc said:
i change this code that error (i think for Paper (2)), this a sample for show for what range placed 4 rows and you test on it but main sheet is Paper, for Work like this, this code may working but please see this code, and what about this range 1048573:1048576?
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").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
Click to expand...
this code ok and about range you said for insert rows, however just problem with create two more create customers, with two customer is ok but when i create customer 3, this not work correctly
 
Upvote 0
Unexpc said:
a question, this is hidden last customer?
Click to expand...
This hide only New Customer 4 rows.
Unexpc said:
this code ok and about range you said for insert rows, however just problem with create two more create customers, with two customer is ok but when i create customer 3, this not work correctly
Click to expand...

I think its work correctly, you told it for first hiding code. Test it again.
 
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
388
Golaidron
G
T
  • Solved
Adding additional text to a value pulled from another sheet
Replies
8
Views
250
Snakehips
Snakehips
T
  • Solved
MATCH function
2
Replies
14
Views
364
Fluff
Fluff
I
  • Question
Copy worksheet but the new worksheet to omit some items
2
Replies
11
Views
594
ipbr21054
I
szita2000
  • Question
Index Match Match from a named table to a range
Replies
1
Views
470
Alex Blakenburg
A

Forum statistics

Threads
1,216,763
Messages
6,132,584
Members
449,737
Latest member
naes

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