Press a cell and then create cells with specific formula

Unexpc

Active Member
Joined
Nov 12, 2020
Messages
446
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: 14
  • Screenshot 2021-03-27 180524.png
    Screenshot 2021-03-27 180524.png
    11.6 KB · Views: 13

Unexpc

Active Member
Joined
Nov 12, 2020
Messages
446
Office Version
  1. 2019
Platform
  1. Windows
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.
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
Are you sure you paste code completely?
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: 1

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,601
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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:

Unexpc

Active Member
Joined
Nov 12, 2020
Messages
446
Office Version
  1. 2019
Platform
  1. Windows
When you see error which line of code see yellow?
nothing highlight just show error
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
please see this, see problem (first customer is ok but for other see) :( : Book T=M Test.xlsm
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,601
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
because you change grey color you used before. at the file you uploaded grey color code is 14211288 Not 14277081
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,601
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

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
 

Unexpc

Active Member
Joined
Nov 12, 2020
Messages
446
Office Version
  1. 2019
Platform
  1. Windows
because you change grey color you used before. at the file you uploaded grey color code is 14211288 Not 14277081
i not change that
After that use this code for Dashboard:
but with this solved, sorry again but i not remember changed color
Please don't upload excel file with macro on google sheets, I cannot see and download macro from google sheets.
so can i upload in rar?
and
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?
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?
 

Unexpc

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

Unexpc

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

Forum statistics

Threads
1,144,370
Messages
5,723,960
Members
422,529
Latest member
mbilal429

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
Top