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