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
For First Problem. One Time Right Click on New Customer & Remove Hyperlink. Then with Last code you don't have problem.
I don't understand what you say Exact. Please Clarify more ( with example it is better)
I write code to unhide 4 row for new customer. Copy them for customer added and then Hide only 4 row for New Customer.
 
Upvote 0

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
maabadi said:
For First Problem. One Time Right Click on New Customer & Remove Hyperlink. Then with Last code you don't have problem.
Click to expand...
i find out, when i delete several customer in one time, this happened and create hyperlink, even i delete hyperlink and after that delete several customer, this happened too
maabadi said:
I write code to unhide 4 row for new customer. Copy them for customer added and then Hide only 4 row for New Customer.
Click to expand...
i don't understand completely, but i have question
1. 4 specific row in 1048573:1048576?
2. unhide this specific rows or for insert new customer rows?
because for me new customer that i insert is hidden after i insert and when i unhide insert new customer rows, that is nothing...
 
Upvote 0
1. No. 4 row for new customer. If new customer at Work Worksheet is in row 40, then row 40-43 hide and after inserting new customer row 44- 47 hides.
2. With this code you don't need unhide rows of New Customer & Codes don't allow to you to unhide that rows.

I should check code for several customer Deleting.
 
Upvote 0
maabadi said:
1. No. 4 row for new customer. If new customer at Work Worksheet is in row 40, then row 40-43 hide and after inserting new customer row 44- 47 hides.
2. With this code you don't need unhide rows of New Customer & Codes don't allow to you to unhide that rows.
Click to expand...
i don't know :) but i say again, i move 4 specific row to 1048573:1048576, because i want not see this, this is source for create new customer, after i hide 1048573:1048576, now i want when select new customer in dashboard, first unhide 1048573:1048576, second copy and third paste for insert new customer and forth hide 1048573:1048576 again, this is doing like a source that copy from that and paste for insert new customer, all i want hide this 4 specific row and copy from that and continue function for insert new customer, that you mean this?
 
Upvote 0
Again what is problem with my last codes sent?
It hides 4 row at any location at column A that started first row with New Customer.
If New Customer is in row 100 then hide rows 100-103. If in row 147 hides 147-150.
But for first time you should hide that 4 rows at Work & Paper Sheet.
 
Upvote 0
First you should hide 4 rows With Starting New Customer at Work & Paper Sheet.
This is code for delete multiple customer & hiding new customer after adding or Deleting Customers
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
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 + Target.Rows.Count - 1), Range("N3:N" & Lr2 + Target.Rows.Count - 1))) 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.EnableEvents = False
If Not Intersect(Target, Range("I3:I" & Lr1 + Target.Rows.Count - 1)) Is Nothing Then
M1 = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 30), 0)
Sheets("Work").Rows(M1 & ":" & M1 + 3).Hidden = False
Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
M1 = Application.WorksheetFunction.Match(Range("I" & Target.Row - 1), Sheets("Work").Range("A1:A" & Lr3), 0)
If M1 = 0 Or Target.Row = 3 Then
M1 = 1
GoTo Resum2
End If
For i = M1 + 2 To Lr3
If Sheets("work").Range("A" & i).Interior.Color = 4697456 Then
M1 = i
GoTo Resum2
End If
Next i
Resum2:
M2 = Application.WorksheetFunction.Match(Range("I" & Target.Row), Sheets("Work").Range("A1:A" & Lr3), 0) - 1
If M2 = 4 Then M1 = 1
Sheets("Work").Rows(M1 & ":" & M2).Delete
M1 = Target.Rows.Count
If Lr1 = Target.Row + Target.Rows.Count - 1 Then M1 = 0
For i = Target.Row To Lr1 - M1
  If i = 3 Then
     Range("J" & i).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
  ElseIf i > 3 Then
     Range("J" & i - 1 & ":J" & i).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & i - 1 & ":K" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & i - 1 & ":L" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
  End If
If i = Lr1 - Target.Rows.Count + 1 Then GoTo Resum5
    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 = "Arial"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

Next i
Resum5:
M2 = Application.WorksheetFunction.Match("New Customer", Range("I1:I" & Lr1), 0)
Range("J" & M2 & ":L" & M2 + Target.Rows.Count - 1).Delete Shift:=xlUp
Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Work").Rows(Lr3 & ":" & Lr3 + 3).Hidden = True
End If

If Not Intersect(Target, Range("N3:N" & Lr2 + Target.Rows.Count - 1)) Is Nothing Then
M1 = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4 + 30), 0)
Sheets("Paper").Rows(M1 & ":" & M1 + 3).Hidden = False
Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
M1 = Application.WorksheetFunction.Match(Range("N" & Target.Row - 1), Sheets("Paper").Range("A1:A" & Lr4), 0)
If M1 = 0 Or Target.Row = 3 Then
M1 = 1
GoTo Resum3
End If
For i = M1 + 2 To Lr4
If Sheets("Paper").Range("A" & i).Interior.Color = 12874308 Then
M1 = i
GoTo Resum3
End If
Next i
Resum3:
M2 = Application.WorksheetFunction.Match(Range("N" & Target.Row), Sheets("Paper").Range("A1:A" & Lr4), 0) - 1
If M2 = 4 Then M1 = 1
Sheets("Paper").Rows(M1 & ":" & M2).Delete
M1 = Target.Rows.Count
If Lr2 = Target.Row + Target.Rows.Count - 1 Then M1 = 0
For i = Target.Row To Lr2 - M1
  If i = 3 Then
     Range("O" & i).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
  ElseIf i > 3 Then
     Range("O" & i - 1 & ":O" & i).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & i - 1 & ":P" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & i - 1 & ":Q" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
  End If
If i = Lr2 - Target.Rows.Count + 1 Then GoTo Resum6
    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 = "Arial"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

Next i
Resum6:
M2 = Application.WorksheetFunction.Match("New Customer", Range("N1:N" & Lr2), 0)
Range("O" & M2 & ":Q" & M2 + Target.Rows.Count - 1).Delete Shift:=xlUp
Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Paper").Rows(Lr4 & ":" & Lr4 + 3).Hidden = True
End If

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
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
     Application.EnableEvents = False
     M1 = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 30), 0)
     Sheets("Work").Rows(M1 & ":" & M1 + 3).Hidden = False
     Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Application.EnableEvents = True
     Exit Sub
     Else
     Range("I" & Lr1 & ":M" & Lr1).Insert Shift:=xlDown
     i = Application.WorksheetFunction.Match(Cr3, Sheets("Work").Range("A1:A" & Lr3), 0)
     If i = False Then
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3), 0)
     Sheets("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)
     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
     End If
     End If
   
  If M2 = 3 Then
     Range("J3").FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
     Range("J3:L3").AutoFill Destination:=Range("J3:L" & Lr1)
  ElseIf M2 = 4 Then
     Range("J3").FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
     Range("J3:L3").AutoFill Destination:=Range("J3:L" & Lr1)
  ElseIf M2 > 4 Then
     Range("J3:L3").AutoFill Destination:=Range("J3:L" & Lr1)
  End If
   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 = "Arial"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

Next i
     Sheets("Work").Activate
     Sheets("Work").Range("A" & M1).Select
     Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
     Sheets("Work").Rows(Lr3 & ":" & Lr3 + 3).Hidden = True
     Application.EnableEvents = True

  End If
    If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then
    If Target.Count = 1 Then
    Application.EnableEvents = False
    M1 = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4 + 30), 0)
    Sheets("Paper").Rows(M1 & ":" & M1 + 3).Hidden = False
    Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Application.EnableEvents = True
     Exit Sub
     Else
     Range("N" & Lr2 & ":Q" & Lr2).Insert Shift:=xlDown
     i = Application.WorksheetFunction.Match(Cr3, Sheets("Paper").Range("A1:A" & Lr4), 0)
     If i = False Then
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4), 0)
     Sheets("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)
     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
   
     If M2 = 3 Then
     Range("O3").FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     Range("O3:Q3").AutoFill Destination:=Range("O3:Q" & Lr2)
     ElseIf M2 = 4 Then
     Range("O3").FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     Range("O3:Q3").AutoFill Destination:=Range("O3:Q" & Lr2)
     ElseIf M2 > 4 Then
     Range("O3:Q3").AutoFill Destination:=Range("O3:Q" & Lr2)
     End If
     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 = "Arial"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With
    Next i
     Sheets("Paper").Activate
     Sheets("Paper").Range("A" & M1).Select
     Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
     Sheets("Paper").Rows(Lr4 & ":" & Lr4 + 3).Hidden = True
    Application.EnableEvents = True
   End If
  End If
End Sub
 
Upvote 0
maabadi said:
First you should hide 4 rows With Starting New Customer at Work & Paper Sheet.
This is code for delete multiple customer & hiding new customer after adding or Deleting Customers
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
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 + Target.Rows.Count - 1), Range("N3:N" & Lr2 + Target.Rows.Count - 1))) 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.EnableEvents = False
If Not Intersect(Target, Range("I3:I" & Lr1 + Target.Rows.Count - 1)) Is Nothing Then
M1 = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 30), 0)
Sheets("Work").Rows(M1 & ":" & M1 + 3).Hidden = False
Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
M1 = Application.WorksheetFunction.Match(Range("I" & Target.Row - 1), Sheets("Work").Range("A1:A" & Lr3), 0)
If M1 = 0 Or Target.Row = 3 Then
M1 = 1
GoTo Resum2
End If
For i = M1 + 2 To Lr3
If Sheets("work").Range("A" & i).Interior.Color = 4697456 Then
M1 = i
GoTo Resum2
End If
Next i
Resum2:
M2 = Application.WorksheetFunction.Match(Range("I" & Target.Row), Sheets("Work").Range("A1:A" & Lr3), 0) - 1
If M2 = 4 Then M1 = 1
Sheets("Work").Rows(M1 & ":" & M2).Delete
M1 = Target.Rows.Count
If Lr1 = Target.Row + Target.Rows.Count - 1 Then M1 = 0
For i = Target.Row To Lr1 - M1
  If i = 3 Then
     Range("J" & i).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
  ElseIf i > 3 Then
     Range("J" & i - 1 & ":J" & i).FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K" & i - 1 & ":K" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L" & i - 1 & ":L" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
  End If
If i = Lr1 - Target.Rows.Count + 1 Then GoTo Resum5
    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 = "Arial"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

Next i
Resum5:
M2 = Application.WorksheetFunction.Match("New Customer", Range("I1:I" & Lr1), 0)
Range("J" & M2 & ":L" & M2 + Target.Rows.Count - 1).Delete Shift:=xlUp
Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Work").Rows(Lr3 & ":" & Lr3 + 3).Hidden = True
End If

If Not Intersect(Target, Range("N3:N" & Lr2 + Target.Rows.Count - 1)) Is Nothing Then
M1 = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4 + 30), 0)
Sheets("Paper").Rows(M1 & ":" & M1 + 3).Hidden = False
Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
M1 = Application.WorksheetFunction.Match(Range("N" & Target.Row - 1), Sheets("Paper").Range("A1:A" & Lr4), 0)
If M1 = 0 Or Target.Row = 3 Then
M1 = 1
GoTo Resum3
End If
For i = M1 + 2 To Lr4
If Sheets("Paper").Range("A" & i).Interior.Color = 12874308 Then
M1 = i
GoTo Resum3
End If
Next i
Resum3:
M2 = Application.WorksheetFunction.Match(Range("N" & Target.Row), Sheets("Paper").Range("A1:A" & Lr4), 0) - 1
If M2 = 4 Then M1 = 1
Sheets("Paper").Rows(M1 & ":" & M2).Delete
M1 = Target.Rows.Count
If Lr2 = Target.Row + Target.Rows.Count - 1 Then M1 = 0
For i = Target.Row To Lr2 - M1
  If i = 3 Then
     Range("O" & i).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
  ElseIf i > 3 Then
     Range("O" & i - 1 & ":O" & i).FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P" & i - 1 & ":P" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q" & i - 1 & ":Q" & i).FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
  End If
If i = Lr2 - Target.Rows.Count + 1 Then GoTo Resum6
    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 = "Arial"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

Next i
Resum6:
M2 = Application.WorksheetFunction.Match("New Customer", Range("N1:N" & Lr2), 0)
Range("O" & M2 & ":Q" & M2 + Target.Rows.Count - 1).Delete Shift:=xlUp
Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Paper").Rows(Lr4 & ":" & Lr4 + 3).Hidden = True
End If

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
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
     Application.EnableEvents = False
     M1 = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3 + 30), 0)
     Sheets("Work").Rows(M1 & ":" & M1 + 3).Hidden = False
     Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Application.EnableEvents = True
     Exit Sub
     Else
     Range("I" & Lr1 & ":M" & Lr1).Insert Shift:=xlDown
     i = Application.WorksheetFunction.Match(Cr3, Sheets("Work").Range("A1:A" & Lr3), 0)
     If i = False Then
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Work").Range("A1:A" & Lr3), 0)
     Sheets("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)
     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
     End If
     End If
   
  If M2 = 3 Then
     Range("J3").FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
     Range("J3:L3").AutoFill Destination:=Range("J3:L" & Lr1)
  ElseIf M2 = 4 Then
     Range("J3").FormulaR1C1 = "=IFERROR(INDEX(Work!C[-8],MATCH(R[1]C9,Work!C[-9],0)-2,0),"""")"
     Range("K3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-7],MATCH(RC9,Work!C[-10],0)+1,0):INDEX(Work!C[-6],MATCH(R[1]C9,Work!C[-10],0)-2,0)),"""")"
     Range("L3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Work!C[-6],MATCH(RC9,Work!C[-11],0)+1,0):INDEX(Work!C[-5],MATCH(R[1]C9,Work!C[-11],0)-2,0)),"""")"
     Range("J3:L3").AutoFill Destination:=Range("J3:L" & Lr1)
  ElseIf M2 > 4 Then
     Range("J3:L3").AutoFill Destination:=Range("J3:L" & Lr1)
  End If
   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 = "Arial"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With

Next i
     Sheets("Work").Activate
     Sheets("Work").Range("A" & M1).Select
     Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
     Sheets("Work").Rows(Lr3 & ":" & Lr3 + 3).Hidden = True
     Application.EnableEvents = True

  End If
    If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then
    If Target.Count = 1 Then
    Application.EnableEvents = False
    M1 = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4 + 30), 0)
    Sheets("Paper").Rows(M1 & ":" & M1 + 3).Hidden = False
    Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Application.EnableEvents = True
     Exit Sub
     Else
     Range("N" & Lr2 & ":Q" & Lr2).Insert Shift:=xlDown
     i = Application.WorksheetFunction.Match(Cr3, Sheets("Paper").Range("A1:A" & Lr4), 0)
     If i = False Then
     i = Application.WorksheetFunction.Match("New Customer", Sheets("Paper").Range("A1:A" & Lr4), 0)
     Sheets("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)
     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
   
     If M2 = 3 Then
     Range("O3").FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     Range("O3:Q3").AutoFill Destination:=Range("O3:Q" & Lr2)
     ElseIf M2 = 4 Then
     Range("O3").FormulaR1C1 = "=IFERROR(INDEX(Paper!C[-13],MATCH(R[1]C14,Paper!C[-14],0)-2,0),"""")"
     Range("P3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-12],MATCH(RC14,Paper!C[-15],0)+1,0):INDEX(Paper!C[-11],MATCH(R[1]C14,Paper!C[-15],0)-2,0)),"""")"
     Range("Q3").FormulaR1C1 = "=IFERROR(SUM(INDEX(Paper!C[-11],MATCH(RC14,Paper!C[-16],0)+1,0):INDEX(Paper!C[-10],MATCH(R[1]C14,Paper!C[-16],0)-2,0)),"""")"
     Range("O3:Q3").AutoFill Destination:=Range("O3:Q" & Lr2)
     ElseIf M2 > 4 Then
     Range("O3:Q3").AutoFill Destination:=Range("O3:Q" & Lr2)
     End If
     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 = "Arial"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With
    Next i
     Sheets("Paper").Activate
     Sheets("Paper").Range("A" & M1).Select
     Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
     Sheets("Paper").Rows(Lr4 & ":" & Lr4 + 3).Hidden = True
    Application.EnableEvents = True
   End If
  End If
End Sub
Click to expand...
Yes, this is correct, and you keep 4 specific row at first excel rows and you say hide it, i know what you say, please see this photos
 

Attachments

  • Annotation 2021-05-06 143153.jpg
    Annotation 2021-05-06 143153.jpg
    76.4 KB · Views: 4
  • Annotation 2021-05-06 143159.jpg
    Annotation 2021-05-06 143159.jpg
    52.7 KB · Views: 4
  • Annotation 2021-05-06 143202.jpg
    Annotation 2021-05-06 143202.jpg
    35.7 KB · Views: 3
  • Annotation 2021-05-06 143742.jpg
    Annotation 2021-05-06 143742.jpg
    22.5 KB · Views: 3
Upvote 0
This situation not different. At both for copying, yiu should first unhide that 4 row copy them for adding customer and then hide them again. No difference.
 
Upvote 0
maabadi said:
This situation not different. At both for copying, yiu should first unhide that 4 row copy them for adding customer and then hide them again. No difference.
Click to expand...
but number rows after last customer i insert will be hidden, like you said before, i want 4 rows last excel rows just hidden and keep this hidden
 
Upvote 0
It cann't be done, Because when you want Insert rows for adding new customer then you see error because you have data at last row and then they don't have rows to go down.
 
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
315
Golaidron
G
T
  • Solved
Adding additional text to a value pulled from another sheet
Replies
8
Views
156
Snakehips
Snakehips
T
  • Solved
MATCH function
2
Replies
14
Views
209
Fluff
Fluff
I
  • Question
Copy worksheet but the new worksheet to omit some items
2
Replies
11
Views
483
ipbr21054
I
szita2000
  • Question
Index Match Match from a named table to a range
Replies
1
Views
373
Alex Blakenburg
A

Forum statistics

Threads
1,215,701
Messages
6,126,308
Members
449,308
Latest member
VerifiedBleachersAttendee

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