Press a cell and then create cells with specific formula

U

Unexpc

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

Attachments

  • Screenshot 2021-03-27 180521.png
    Screenshot 2021-03-27 180521.png
    7 KB · Views: 18
  • Screenshot 2021-03-27 180524.png
    Screenshot 2021-03-27 180524.png
    11.6 KB · Views: 16
Sort by date Sort by votes
maabadi said:
This is because of formula and I cann't do any about that except change formula. Please tell me What you want from formula exactly. specially for first customer with example & data at WORK Sheet.
Click to expand...
for Work and Paper, Column J and Column O in Dashboard is in Work and Paper about last data in Column B, for Column K and P in Dashboard is in Work and Paper about SUM of Columns D&E, for Column L and Column Q in Dashboard is in Work and Paper about SUM of Columns F&G, file (not insert new codes, with previous codes i used for 3 sheets) : Book T=PTest.xlsm
maabadi said:
Are you sure you paste code completely?
Click to expand...
yes, show this error after i pasted in module
 

Attachments

  • image_2021-09-29_143116.png
    image_2021-09-29_143116.png
    5 KB · Views: 3
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
When you see error which line of code see yellow?

I change and simplified Formulas for you. delete all customers at dashboard sheet and try this new formula and see this is what you want:
try this for Dashboard Sheet
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, M3 As String, W 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
Application.ScreenUpdating = False
If Not Intersect(Target, Range("I3:I" & Lr1)) Is Nothing Then
        M1 = Target.Row
        M3 = Target.Value
        Application.Undo
        If M1 = Target.Row Then
           M2 = Application.WorksheetFunction.Match(Target.Value, Sheets("Work").Range("A1:A" & Lr3), 0)
           Sheets("Work").Range("A" & M2).Value = M3
           Target.Value = M3
           GoTo Resum1
        Else
           Range("I" & M1 & ":L" & M1 + Target.Rows.Count - 1).Delete Shift:=xlUp
           M1 = 0
        End If
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("A1:A" & Lr3 + 100).Find("", , , , , xlPrevious, , , True).Row
Sheets("Work").Rows(M1 & ":" & M2).Delete
M = M2 - M1 + 1
Sheets("Work").Rows(Rows.Count - M & ":" & Rows.Count).Hidden = True
Resum1:
For i = Target.Row To Lr1 - Target.Rows.Count + 1
M1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3), 0) + 1
M2 = Sheets("Work").Range("A" & M1 & ":A" & Lr3 + 100).Find("", , , , , xlNext, , , True).Row - 1
    Range("J" & i).Formula = "=Work!B" & M2
    Range("K" & i).Formula = "=SUM(Work!D" & M1 & ":E" & M2 & ")"
    Range("L" & i).Formula = "=SUM(Work!F" & M1 & ":G" & M2 & ")"

    If i = Lr1 - Target.Rows.Count + 1 Then GoTo Resum4
    Cr1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3 + 20), 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
'M2 = 0
'M2 = Sheets("Work").Range("A1:A" & Rows.Count - 100).Find("", , , , , xlPrevious, , , True).Row
'Sheets("Work").Rows(M2 + 1 & ":" & Rows.Count).Hidden = True

End If




If Not Intersect(Target, Range("N3:N" & Lr2)) Is Nothing Then
        M1 = Target.Row
        M3 = Target.Value
        Application.Undo
        If M1 = Target.Row Then
           M2 = Application.WorksheetFunction.Match(Target.Value, Sheets("Paper").Range("A1:A" & Lr4), 0)
           Sheets("Paper").Range("A" & M2).Value = M3
           Target.Value = M3
           GoTo Resum2
        Else
           Range("N" & M1 & ":Q" & M1 + Target.Rows.Count - 1).Delete Shift:=xlUp
           M1 = 0
        End If
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("A1:A" & Lr4 + 100).Find("", , , , , xlPrevious, , , True).Row
Sheets("Paper").Rows(M1 & ":" & M2).Delete
M = M2 - M1 + 1
Sheets("Paper").Rows(Rows.Count - M & ":" & Rows.Count).Hidden = True
Resum2:
For i = Target.Row To Lr2 - Target.Rows.Count + 1
M1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Paper").Range("A1:A" & Lr4), 0) + 1
M2 = Sheets("Paper").Range("A" & M1 & ":A" & Lr4 + 100).Find("", , , , , xlNext, , , True).Row - 1
    Range("O" & i).Formula = "=Paper!B" & M2
    Range("P" & i).Formula = "=SUM(Paper!D" & M1 & ":E" & M2 & ")"
    Range("Q" & i).Formula = "=SUM(Paper!F" & M1 & ":G" & M2 & ")"


    If i = Lr2 - Target.Rows.Count + 1 Then GoTo Resum5
    Cr1 = Application.WorksheetFunction.Match(Range("N" & i), Sheets("Paper").Range("A1:A" & Lr4 + 20), 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
'M2 = 0
'M2 = Sheets("Paper").Range("A1:A" & Rows.Count - 100).Find("", , , , , xlPrevious, , , True).Row
'Sheets("Paper").Rows(M2 + 1 & ":" & Rows.Count).Hidden = True

End If
Application.FindFormat.Clear
Application.ScreenUpdating = True
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, M3 As Long
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


    Application.ScreenUpdating = False

  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.ScreenUpdating = True
     Application.EnableEvents = True
     Exit Sub
     Else
     Application.FindFormat.Clear
     Application.FindFormat.Interior.Color = 14277081
     M3 = Sheets("Work").Range("A1:A" & Rows.Count).Find("", , , , , xlPrevious, , , True).Row
     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.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("", , , , , xlPrevious, , , True).Row + 1
     If M1 = 0 Then M1 = 1
     Sheets("Sheet1").Range("A1:G4").Copy
     Sheets("Work").Range("A" & M1 & ":G" & M1).Insert Shift:=xlDown
     Sheets("Work").Rows(M3 + 1 & ":" & M3 + 4).Hidden = False
     Sheets("Work").Range("A" & M1).Value = Cr3
     Sheets("Work").Range("A" & M1).Font.ColorIndex = xlColorIndexAutomatic
     End If
     End If

   For i = M2 To Lr1
    M1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3), 0) + 1
    M = Sheets("Work").Range("A" & M1 & ":A" & Lr3 + 100).Find("", , , , , xlNext, , , True).Row - 1
    Range("J" & i).Formula = "=Work!B" & M
    Range("K" & i).Formula = "=SUM(Work!D" & M1 & ":E" & M & ")"
    Range("L" & i).Formula = "=SUM(Work!F" & M1 & ":G" & M & ")"

    Cr1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3 + 20), 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
'     M3 = Sheets("Work").Range("A1:A" & Rows.Count - 100).Find("", , , , , xlPrevious, , , True).Row
'     Sheets("Work").Rows(M3 + 1 & ":" & Rows.Count).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
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Application.ScreenUpdating = True
     Application.EnableEvents = True
     Exit Sub
     Else
     Application.FindFormat.Clear
     Application.FindFormat.Interior.Color = 14277081
     M3 = Sheets("Paper").Range("A1:A" & Rows.Count).Find("", , , , , xlPrevious, , , True).Row
     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("", , , , , xlPrevious, , , True).Row + 1
     If M1 = 0 Then M1 = 1
     Sheets("Sheet1").Range("A5:G8").Copy
     Sheets("Paper").Range("A" & M1 & ":G" & M1).Insert Shift:=xlDown
     Sheets("Paper").Rows(M3 + 1 & ":" & M3 + 4).Hidden = False
     Sheets("Paper").Range("A" & M1).Value = Cr3
     Sheets("Paper").Range("A" & M1).Font.ColorIndex = xlColorIndexAutomatic
     End If
     End If

    For i = M2 To Lr2
        M1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Paper").Range("A1:A" & Lr4), 0) + 1
        M2 = Sheets("Paper").Range("A" & M1 & ":A" & Lr4 + 100).Find("", , , , , xlNext, , , True).Row - 1
        Range("O" & i).Formula = "=Paper!B" & M2
        Range("P" & i).Formula = "=SUM(Paper!D" & M1 & ":E" & M2 & ")"
        Range("Q" & i).Formula = "=SUM(Paper!F" & M1 & ":G" & M2 & ")"
        Cr1 = Application.WorksheetFunction.Match(Range("N" & i), Sheets("Paper").Range("A1:A" & Lr4 + 20), 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
'     M3 = Sheets("Paper").Range("A1:A" & Rows.Count - 100).Find("", , , , , xlPrevious, , , True).Row
'     Sheets("Paper").Rows(M3 + 1 & ":" & Rows.Count).Hidden = True
      End If
  End If
  Application.FindFormat.Clear
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub
 
Last edited:
Upvote 0
maabadi said:
When you see error which line of code see yellow?
Click to expand...
nothing highlight just show error
maabadi said:
I change and simplified Formulas for you. delete all customers at dashboard sheet and try this new formula and see this is what you want:
try this for Dashboard Sheet
Click to expand...
please see this, see problem (first customer is ok but for other see) :( : Book T=M Test.xlsm
 
Upvote 0
because you change grey color you used before. at the file you uploaded grey color code is 14211288 Not 14277081
 
Upvote 0
Please don't upload excel file with macro on google sheets, I cannot see and download macro from google sheets.
After that use this code for Dashboard:
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, M3 As String, W 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
Application.ScreenUpdating = False
If Not Intersect(Target, Range("I3:I" & Lr1)) Is Nothing Then
        M1 = Target.Row
        M3 = Target.Value
        Application.Undo
        If M1 = Target.Row Then
           M2 = Application.WorksheetFunction.Match(Target.Value, Sheets("Work").Range("A1:A" & Lr3), 0)
           Sheets("Work").Range("A" & M2).Value = M3
           Target.Value = M3
           GoTo Resum1
        Else
           Range("I" & M1 & ":L" & M1 + Target.Rows.Count - 1).Delete Shift:=xlUp
           M1 = 0
        End If
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("A1:A" & Lr3 + 100).Find("", , , , , xlPrevious, , , True).Row
Sheets("Work").Rows(M1 & ":" & M2).Delete
M = M2 - M1 + 1
Sheets("Work").Rows(Rows.Count - M & ":" & Rows.Count).Hidden = True
Resum1:
For i = Target.Row To Lr1 - Target.Rows.Count + 1
M1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3 + 100), 0) + 1
M2 = Sheets("Work").Range("A" & M1 & ":A" & Lr3 + 100).Find("", , , , , xlNext, , , True).Row - 1
    Range("J" & i).Formula = "=Work!B" & M2
    Range("K" & i).Formula = "=SUM(Work!D" & M1 & ":E" & M2 & ")"
    Range("L" & i).Formula = "=SUM(Work!F" & M1 & ":G" & M2 & ")"

    If i = Lr1 - Target.Rows.Count + 1 Then GoTo Resum4
    Cr1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3 + 100), 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
'M2 = 0
'M2 = Sheets("Work").Range("A1:A" & Rows.Count - 100).Find("", , , , , xlPrevious, , , True).Row
'Sheets("Work").Rows(M2 + 1 & ":" & Rows.Count).Hidden = True

End If




If Not Intersect(Target, Range("N3:N" & Lr2)) Is Nothing Then
        M1 = Target.Row
        M3 = Target.Value
        Application.Undo
        If M1 = Target.Row Then
           M2 = Application.WorksheetFunction.Match(Target.Value, Sheets("Paper").Range("A1:A" & Lr4), 0)
           Sheets("Paper").Range("A" & M2).Value = M3
           Target.Value = M3
           GoTo Resum2
        Else
           Range("N" & M1 & ":Q" & M1 + Target.Rows.Count - 1).Delete Shift:=xlUp
           M1 = 0
        End If
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("A1:A" & Lr4 + 100).Find("", , , , , xlPrevious, , , True).Row
Sheets("Paper").Rows(M1 & ":" & M2).Delete
M = M2 - M1 + 1
Sheets("Paper").Rows(Rows.Count - M & ":" & Rows.Count).Hidden = True
Resum2:
For i = Target.Row To Lr2 - Target.Rows.Count + 1
M1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Paper").Range("A1:A" & Lr4 + 100), 0) + 1
M2 = Sheets("Paper").Range("A" & M1 & ":A" & Lr4 + 100).Find("", , , , , xlNext, , , True).Row - 1
    Range("O" & i).Formula = "=Paper!B" & M2
    Range("P" & i).Formula = "=SUM(Paper!D" & M1 & ":E" & M2 & ")"
    Range("Q" & i).Formula = "=SUM(Paper!F" & M1 & ":G" & M2 & ")"


    If i = Lr2 - Target.Rows.Count + 1 Then GoTo Resum5
    Cr1 = Application.WorksheetFunction.Match(Range("N" & i), Sheets("Paper").Range("A1:A" & Lr4 + 100), 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
'M2 = 0
'M2 = Sheets("Paper").Range("A1:A" & Rows.Count - 100).Find("", , , , , xlPrevious, , , True).Row
'Sheets("Paper").Rows(M2 + 1 & ":" & Rows.Count).Hidden = True

End If
Application.FindFormat.Clear
Application.ScreenUpdating = True
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, M3 As Long, M As Long
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


    Application.ScreenUpdating = False

  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.ScreenUpdating = True
     Application.EnableEvents = True
     Exit Sub
     Else
     Application.FindFormat.Clear
     Application.FindFormat.Interior.Color = 14277081
     M3 = Sheets("Work").Range("A1:A" & Rows.Count).Find("", , , , , xlPrevious, , , True).Row
     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.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("", , , , , xlPrevious, , , True).Row + 1
     If M1 = 0 Then M1 = 1
     Sheets("Sheet1").Range("A1:G4").Copy
     Sheets("Work").Range("A" & M1 & ":G" & M1).Insert Shift:=xlDown
     Sheets("Work").Rows(M3 + 1 & ":" & M3 + 4).Hidden = False
     Sheets("Work").Range("A" & M1).Value = Cr3
     Sheets("Work").Range("A" & M1).Font.ColorIndex = xlColorIndexAutomatic
     End If
     End If

   For i = M2 To Lr1
    M1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3 + 100), 0) + 1
    M = Sheets("Work").Range("A" & M1 & ":A" & Lr3 + 100).Find("", , , , , xlNext, , , True).Row - 1
    Range("J" & i).Formula = "=Work!B" & M
    Range("K" & i).Formula = "=SUM(Work!D" & M1 & ":E" & M & ")"
    Range("L" & i).Formula = "=SUM(Work!F" & M1 & ":G" & M & ")"

    Cr1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Work").Range("A1:A" & Lr3 + 20), 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
'     M3 = Sheets("Work").Range("A1:A" & Rows.Count - 100).Find("", , , , , xlPrevious, , , True).Row
'     Sheets("Work").Rows(M3 + 1 & ":" & Rows.Count).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
     Cr3 = Application.InputBox(prompt:="Please Input New Customer Name", Type:=2)
     If Cr3 = False Then
     Application.ScreenUpdating = True
     Application.EnableEvents = True
     Exit Sub
     Else
     Application.FindFormat.Clear
     Application.FindFormat.Interior.Color = 14277081
     M3 = Sheets("Paper").Range("A1:A" & Rows.Count).Find("", , , , , xlPrevious, , , True).Row
     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("", , , , , xlPrevious, , , True).Row + 1
     If M1 = 0 Then M1 = 1
     Sheets("Sheet1").Range("A5:G8").Copy
     Sheets("Paper").Range("A" & M1 & ":G" & M1).Insert Shift:=xlDown
     Sheets("Paper").Rows(M3 + 1 & ":" & M3 + 4).Hidden = False
     Sheets("Paper").Range("A" & M1).Value = Cr3
     Sheets("Paper").Range("A" & M1).Font.ColorIndex = xlColorIndexAutomatic
     End If
     End If

    For i = M2 To Lr2
        M1 = Application.WorksheetFunction.Match(Range("I" & i), Sheets("Paper").Range("A1:A" & Lr4 + 100), 0) + 1
        M2 = Sheets("Paper").Range("A" & M1 & ":A" & Lr4 + 100).Find("", , , , , xlNext, , , True).Row - 1
        Range("O" & i).Formula = "=Paper!B" & M2
        Range("P" & i).Formula = "=SUM(Paper!D" & M1 & ":E" & M2 & ")"
        Range("Q" & i).Formula = "=SUM(Paper!F" & M1 & ":G" & M2 & ")"
        Cr1 = Application.WorksheetFunction.Match(Range("N" & i), Sheets("Paper").Range("A1:A" & Lr4 + 20), 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
'     M3 = Sheets("Paper").Range("A1:A" & Rows.Count - 100).Find("", , , , , xlPrevious, , , True).Row
'     Sheets("Paper").Rows(M3 + 1 & ":" & Rows.Count).Hidden = True
      End If
  End If
  Application.FindFormat.Clear
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub
 
Upvote 0
maabadi said:
because you change grey color you used before. at the file you uploaded grey color code is 14211288 Not 14277081
Click to expand...
i not change that
maabadi said:
After that use this code for Dashboard:
Click to expand...
but with this solved, sorry again but i not remember changed color
maabadi said:
Please don't upload excel file with macro on google sheets, I cannot see and download macro from google sheets.
Click to expand...
so can i upload in rar?
and
maabadi said:
This macro only for correcting unwanted hided & unhided rows and should be added as Module 1 or ...
For me Working correctly. Are you sure you paste code completely?
Click to expand...
can you upload file? i sure paste code completely but before, when i run it, the size of file will be increase to MB? if this happened i think this slowly for me
again i say about problem, with that code hide rows, problems with hidden some rows belong that customer, and when insert rows for a customer, hidden below customers, that can find data between green cell till gray for Work and Blue cell till gray row for Paper and always visible this rows?
 
Upvote 0
maabadi said:
Please don't upload excel file with macro on google sheets, I cannot see and download macro from google sheets.
After that use this code for Dashboard:
Click to expand...
Hi again mabaadi, a problem after i set my data with new workbook with new formats, problem with Dashboard, the problem is with columns data about shows last data (Column J and O) not shows last data (just show first data) and another with SUM (Column K,L,P,Q) just show first data for each customer, example file with rar (for have codes) : Book.rar
 
Upvote 0
i check before and new workbook, formula of two is have difference,
before :
Last Data
=IFERROR(INDEX(Work!B:B,MATCH($I4,Work!A:A,0)-2,0),"")
SUM
=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)),"")
=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)),"")
after :
Last Data
=Work!B3
SUM
=SUM(Work!D2:E3)
=SUM(Work!F2:G3)
this may problem with language you set with English but i use Persian?
 
Upvote 0
I modified all codes at dashboard, Work & Paper Sheet, Replace these code with previous codes at your original file.
Book.xlsm
 
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
286
Golaidron
G
I
  • Question
Copy worksheet but the new worksheet to omit some items
2
Replies
11
Views
419
ipbr21054
I
szita2000
  • Question
Index Match Match from a named table to a range
Replies
1
Views
286
Alex Blakenburg
A
B
  • Question
Copy formula into a cell using vba
2
Replies
11
Views
418
BobtBuilder
B
G
  • Solved
Extract the cells that contains alphanumeric string from the column
Replies
6
Views
365
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,632
Messages
6,120,652
Members
448,975
Latest member
sweeberry

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