Combine Calculate in a cells with several calculate in that cell and after that another calculate based on that cell

[Unexpc]

Hi guys
i have main problem and if you solve this, solve my main problem and helped me to calculate any of numbers that i do this in many hours
this is my problem
i have this worksheet that you see before, in first i said that belong to text, but that have information for main calculate, better say
in one cell i write information with this format : Give (+ Value) or Receive (-Value) ,G Or M, Text, Number, Percent or Thousands or Hundred (if Give and G and Percent: Percent that multiply to Number that written before this (if i not write anything in this part, multiply with 1), if Give and G and Thousands: Thousand multiply with number, if Receive and G and Percent: Percent multiply with number, if Receive and G and Hundred: Hundred multiply with number and then divide 750, for Give M that all this value sum and fill in specific columns that i say in below but for Receive M, if write MM after that calculate: Number multiply MM and divide 4.3318 if not write like Give M Calculate)
This fill in Column A
Columns B:C fill with Text without calculate
but in Column D
This fills with SUM of Gives and Back (+ Value) Calculates from G
in Column E
fills with SUM of Receive (- Value) Calculates from G
in Column F
fills with SUM of Gives (+ Value) Calculates from M
in Column G
fills with SUM of Receive (-Value) Calculates from M
and a point, i can't split information that belong one cell, because all of the info about a day and should write all info in one cell

 

[Unexpc]

This is Complete Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, J As Long, Lr1 As Long, Lr2 As Long, Cr As Long, CrR As String
Dim Lr3 As Long, Lr4 As Long, K As Long
Lr1 = Sheets("Dashboard").Range("I" & Rows.Count).End(xlUp).Row
Lr2 = Sheets("Dashboard").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

  If Intersect(Target, Range("A1:A" & Lr3)) Is Nothing Then Exit Sub
   On Error Resume Next
  Application.EnableEvents = False

  If Target.Interior.Color = 14277081 Then
  If Target.Value <> "" Then
  Range("A" & Target.Row & ":G" & Target.Row + Target.Value - 1).Insert Shift:=xlDown
  Target.Value = ""
  End If
  ElseIf Target.Interior.Color = 16777215 Then

Dim A As Double, B As Double, C As Double, D As Double, E As Double, F As Double, G As Double, H As Double
Dim I2 As String, J2 As Double, K2 As String, L As Double, M As Long, N As Long, O As Long, Lnum As Long
Dim T As String, P As Long, R As Long, S1 As Double, S2 As Double, W As Long, X As Long, Y As Long
Dim ii As Long, bb As Long, cc As String, nn As Long, ee As Double, gg As Double, Lst As String, pp As Long, rr As Long

''' **** For disable each line add  '   symbol to disable that line at code  *****

'' Note: THis remove all ALT+ENTER in The TEXT at the Cell
    Range("A" & Target.Row).Value = Replace(Range("A" & Target.Row).Value, vbLf, "")

T = Range("A" & Target.Row).Value
X = Len(T) - Len(Replace(T, "&", "")) + 1
For M = X To 1 Step -1
  If M < X Then
   Y = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(T, "&", Chr(1), M))
   Range("A" & Target.Row).Characters(Start:=Y, Length:=1).Font.Color = 16777215
  Else
   Y = Len(T)
  End If
   bb = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(Replace(T, "+", "-"), "-", Chr(1), M))
   cc = Trim(Mid(T, bb, 3))
   '' Note:  THis 3 row changes 1. Font size of symbols  2. Font color of them  3. font color of "&" at the end of line
   Range("A" & Target.Row).Characters(Start:=bb + 1, Length:=2).Font.Size = 1
   Range("A" & Target.Row).Characters(Start:=bb + 1, Length:=2).Font.Color = 16777215
   Range("A" & Target.Row).Characters(Start:=Y, Length:=1).Font.Color = 16777215
   O = bb + 1
For N = O To Y
If Mid(T, N, 1) = " " And IsNumeric(Mid(T, N + 1, 1)) Then P = N + 1
If IsNumeric(Mid(T, N, 1)) Or Mid(T, N, 1) = "." Or Mid(T, N, 1) = "/" Then pp = 1
If Not IsNumeric(Mid(T, N + 1, 1)) Or Mid(T, N + 1, 1) = "." Or Mid(T, N + 1, 1) = "." Then rr = 1
If pp = rr And pp > 0 Then R = N
If R >= P And P > 0 And Mid(T, N + 1, 1) = " " Or R = Len(T) Then
        If S1 = 0 Then
            S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
            P = 0
            R = 0
        Else
            S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
        End If
                If S2 <> S1 Then
                    Select Case cc
                    ''   ******************************************************************************** ''
                    ''  Note: Case is symbols after numbers for Order at Case to calculate Based Case Type

                            Case "+#%"
                                If S2 > 0 Then A = A + Round(S1 * (1 + S2 / 100), 2)
                            Case "+#$"
                                If S2 > 0 Then B = B + S1 * S2
                                If S2 > 0 Then J2 = J2 + S1
                            Case "-#%"
                                If S2 > 0 Then C = C + Round(S1 * (1 + S2 / 100) * -1, 2)
                            Case "-#$"
                                If S2 > 0 Then D = D + S1 * S2 * -1
                                If S2 > 0 Then L = L + S1 * -1
                            Case "+#@"
                                If S2 > 0 Then ee = ee + Round((S1 * S2) / 750, 2)
                            Case "-#@"
                                If S2 > 0 Then gg = gg + Round(-(S1 * S2) / 750, 2)
                            Case "+$"
                                E = E + S1 * 1
                            Case "+$$"
                                If S2 > 0 Then F = F + Round((S1 / S2) * 4.3318, 2)
                            Case "-$"
                                G = G + S1 * -1
                            Case "-$$"
                                If S2 > 0 Then H = H + Round((S1 / S2) * -4.3318, 2)

                    End Select
                    '' Note: Because of Case 7 & 9 we have only one number, if change symbol
                    ''       also at the next line should be symbol changes
                    If S2 > 0 Or cc = "+$" Or cc = "-$" Then
                        S1 = 0
                        S2 = 0
                        P = 0
                        R = 0
                        GoTo Resum1
                    End If
                End If
End If

 pp = 0
 rr = 0
Next N
Resum1:
Next M

'' Notes : Here I add calculated results to cells
Range("D" & Target.Row).Formula = "=Round(" & A & "+" & J2 & "+" & F & "+" & ee & ", 2)"
Range("E" & Target.Row).Formula = "=Round(" & C & "+" & L & "+" & H & "+" & gg & ", 2)"
Range("F" & Target.Row).Formula = "=" & B & "+" & E
Range("G" & Target.Row).Formula = "=" & D & "+" & G
'' Note: Add again ALT+ENTER to the Text at the Cell
Range("A" & Target.Row).Value = Replace(Range("A" & Target.Row).Value, "&", "&" & vbLf)

'MsgBox "A1 = " & A & vbCr & "B1 = " & J2 & " // " & "B2 = " & B & vbCr & "C1 = " & C & vbCr & "D1 = " & L & " // " & "D2 = " & D _
& vbCr & "E1 = " & E & vbCr & "F1 = " & F & vbCr & "G1 = " & G & vbCr & "H1 = " & H



  End If
  For i = 3 To Lr1 - 1
   Cr = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & i).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
   CrR = Range("A" & Cr).Address
     Sheets("Dashboard").Range("I" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Sheets("Dashboard").Range("I" & i), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & CrR, TextToDisplay:=Sheets("Dashboard").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
  Application.EnableEvents = True
End Sub

many thanks, im very thankful, actually you save a lot of time,
THANK YOU>>>>>>>>>>>>>>

 

[maabadi]

You're Welcome & Thanks for Feedback.

 

[Unexpc]

This is Complete Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, J As Long, Lr1 As Long, Lr2 As Long, Cr As Long, CrR As String
Dim Lr3 As Long, Lr4 As Long, K As Long
Lr1 = Sheets("Dashboard").Range("I" & Rows.Count).End(xlUp).Row
Lr2 = Sheets("Dashboard").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

  If Intersect(Target, Range("A1:A" & Lr3)) Is Nothing Then Exit Sub
   On Error Resume Next
  Application.EnableEvents = False

  If Target.Interior.Color = 14277081 Then
  If Target.Value <> "" Then
  Range("A" & Target.Row & ":G" & Target.Row + Target.Value - 1).Insert Shift:=xlDown
  Target.Value = ""
  End If
  ElseIf Target.Interior.Color = 16777215 Then

Dim A As Double, B As Double, C As Double, D As Double, E As Double, F As Double, G As Double, H As Double
Dim I2 As String, J2 As Double, K2 As String, L As Double, M As Long, N As Long, O As Long, Lnum As Long
Dim T As String, P As Long, R As Long, S1 As Double, S2 As Double, W As Long, X As Long, Y As Long
Dim ii As Long, bb As Long, cc As String, nn As Long, ee As Double, gg As Double, Lst As String, pp As Long, rr As Long

''' **** For disable each line add  '   symbol to disable that line at code  *****

'' Note: THis remove all ALT+ENTER in The TEXT at the Cell
    Range("A" & Target.Row).Value = Replace(Range("A" & Target.Row).Value, vbLf, "")

T = Range("A" & Target.Row).Value
X = Len(T) - Len(Replace(T, "&", "")) + 1
For M = X To 1 Step -1
  If M < X Then
   Y = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(T, "&", Chr(1), M))
   Range("A" & Target.Row).Characters(Start:=Y, Length:=1).Font.Color = 16777215
  Else
   Y = Len(T)
  End If
   bb = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(Replace(T, "+", "-"), "-", Chr(1), M))
   cc = Trim(Mid(T, bb, 3))
   '' Note:  THis 3 row changes 1. Font size of symbols  2. Font color of them  3. font color of "&" at the end of line
   Range("A" & Target.Row).Characters(Start:=bb + 1, Length:=2).Font.Size = 1
   Range("A" & Target.Row).Characters(Start:=bb + 1, Length:=2).Font.Color = 16777215
   Range("A" & Target.Row).Characters(Start:=Y, Length:=1).Font.Color = 16777215
   O = bb + 1
For N = O To Y
If Mid(T, N, 1) = " " And IsNumeric(Mid(T, N + 1, 1)) Then P = N + 1
If IsNumeric(Mid(T, N, 1)) Or Mid(T, N, 1) = "." Or Mid(T, N, 1) = "/" Then pp = 1
If Not IsNumeric(Mid(T, N + 1, 1)) Or Mid(T, N + 1, 1) = "." Or Mid(T, N + 1, 1) = "." Then rr = 1
If pp = rr And pp > 0 Then R = N
If R >= P And P > 0 And Mid(T, N + 1, 1) = " " Or R = Len(T) Then
        If S1 = 0 Then
            S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
            P = 0
            R = 0
        Else
            S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
        End If
                If S2 <> S1 Then
                    Select Case cc
                    ''   ******************************************************************************** ''
                    ''  Note: Case is symbols after numbers for Order at Case to calculate Based Case Type

                            Case "+#%"
                                If S2 > 0 Then A = A + Round(S1 * (1 + S2 / 100), 2)
                            Case "+#$"
                                If S2 > 0 Then B = B + S1 * S2
                                If S2 > 0 Then J2 = J2 + S1
                            Case "-#%"
                                If S2 > 0 Then C = C + Round(S1 * (1 + S2 / 100) * -1, 2)
                            Case "-#$"
                                If S2 > 0 Then D = D + S1 * S2 * -1
                                If S2 > 0 Then L = L + S1 * -1
                            Case "+#@"
                                If S2 > 0 Then ee = ee + Round((S1 * S2) / 750, 2)
                            Case "-#@"
                                If S2 > 0 Then gg = gg + Round(-(S1 * S2) / 750, 2)
                            Case "+$"
                                E = E + S1 * 1
                            Case "+$$"
                                If S2 > 0 Then F = F + Round((S1 / S2) * 4.3318, 2)
                            Case "-$"
                                G = G + S1 * -1
                            Case "-$$"
                                If S2 > 0 Then H = H + Round((S1 / S2) * -4.3318, 2)

                    End Select
                    '' Note: Because of Case 7 & 9 we have only one number, if change symbol
                    ''       also at the next line should be symbol changes
                    If S2 > 0 Or cc = "+$" Or cc = "-$" Then
                        S1 = 0
                        S2 = 0
                        P = 0
                        R = 0
                        GoTo Resum1
                    End If
                End If
End If

 pp = 0
 rr = 0
Next N
Resum1:
Next M

'' Notes : Here I add calculated results to cells
Range("D" & Target.Row).Formula = "=Round(" & A & "+" & J2 & "+" & F & "+" & ee & ", 2)"
Range("E" & Target.Row).Formula = "=Round(" & C & "+" & L & "+" & H & "+" & gg & ", 2)"
Range("F" & Target.Row).Formula = "=" & B & "+" & E
Range("G" & Target.Row).Formula = "=" & D & "+" & G
'' Note: Add again ALT+ENTER to the Text at the Cell
Range("A" & Target.Row).Value = Replace(Range("A" & Target.Row).Value, "&", "&" & vbLf)

'MsgBox "A1 = " & A & vbCr & "B1 = " & J2 & " // " & "B2 = " & B & vbCr & "C1 = " & C & vbCr & "D1 = " & L & " // " & "D2 = " & D _
& vbCr & "E1 = " & E & vbCr & "F1 = " & F & vbCr & "G1 = " & G & vbCr & "H1 = " & H



  End If
  For i = 3 To Lr1 - 1
   Cr = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & i).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
   CrR = Range("A" & Cr).Address
     Sheets("Dashboard").Range("I" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Sheets("Dashboard").Range("I" & i), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & CrR, TextToDisplay:=Sheets("Dashboard").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
  Application.EnableEvents = True
End Sub

Hi again maabadi, i think for a new way to write the text in column A, please check this can find out like this for each case? i use symbols as a unit, for example عدد is # and تومن is $ (11 to 14 is new cases, 10 and 11 not any calculation with any number of this case just addition and subtraction with D and E, 13 and 14:+1 or -1 *23.5*23000/12000)
its format better to write and faster to find and remember for me
and anyway automatic added list number of first of each case?
file: Book T=T.xlsm

 

[Unexpc]

This is the best format i think, if this work, It will be very good

 

[maabadi]

Please Give me all example again with these new formats.

 

[Unexpc]

Please Give me all example again with these new formats.

file: Book T=T.xlsm

 

[maabadi]

At this new format I don't see symbols after Numbers for Determining case type. Are you want to Use Numbers for Determining Case Type?

 

[Unexpc]

At this new format I don't see symbols after Numbers for Determining case type. Are you want to Use Numbers for Determining Case Type?

you are set symbols at first of each line for define each case, in this new i use symbols like as a unit, for example instead of عدد i write # and don't write this symbols at first for a definition, however this new format can find this symbols in each case and find out what case use and different between other cases?
i mean in old format, this find definition about each case that use specific symbols for each cases, in this new that can find out this symbols that include in each case not at first...

 

[maabadi]

1. We need Change to Format you Used for Symbols at case 5 & 6.
I change position of @ symbol to after of Second Number.
2. Also Remember always you need have space before and after Numbers and Symbols. (case 1 need correction at this new example)
3. what about Case 13 & 14, I should add them to which columns?

 

[maabadi]

This is last format I used with modifications:

Book T=T.xlsm.xlsx
	A	B	C	D	E	F	G
1	New Customer
2
3	1+ جعبه ای 23.5 # 10% & 2+ به صورت حضوری 12 # 23000 $ & 3- به صورت غیر حضوری 56 # 8% & 4- دسته ای 43 # 11000 $ & 5+ کالا 23.000 # 231 @ بر استناد 12324 & 6- کالا 23.000 # 231 @ بر استناد 12324 & 7+ پول 1200000 $ چک از بانک & 8+ پول 2300000 $ بر 3300000 $ & 9- پول 1200000 $ چک از بانک & 10- پول 2300000 $ بر 3300000 $ & 11+ جعبه ای 23.5 # & 12- جعبه ای 23.5 # & 13+ جعبه ای 23.5 # 23000 $ و تبدیل 12000 $ & 14- جعبه ای 23.5 # 23000 $ و تبدیل 12000 $			بد 69.100	بس 132.600	بد 1,476,000	بس 1,673,000
Work

Cell Formulas
Range	Formula
D3	D3	=ROUND(23.5+12+3.02+7.08+23.5, 2)
E3	E3	=ROUND(-56+-43+-3.02+-7.08+-23.5, 2)
F3	F3	=276000+1200000
G3	G3	=-473000+-1200000

I don't add Case 13 & 14 to Column D to F
Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, J As Long, Lr1 As Long, Lr2 As Long, Cr As Long, CrR As String
Dim Lr3 As Long, Lr4 As Long, K As Long
Lr1 = Sheets("Dashboard").Range("I" & Rows.Count).End(xlUp).Row
Lr2 = Sheets("Dashboard").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

  If Intersect(Target, Range("A1:A" & Lr3)) Is Nothing Then Exit Sub
   On Error Resume Next
  Application.EnableEvents = False

  If Target.Interior.Color = 14277081 Then
  If Target.Value <> "" Then
  Range("A" & Target.Row & ":G" & Target.Row + Target.Value - 1).Insert Shift:=xlDown
  Target.Value = ""
  End If
  ElseIf Target.Interior.Color = 16777215 Then

Dim A As Double, B As Double, C As Double, D As Double, E As Double, F As Double, G As Double, H As Double
Dim I2 As String, J2 As Double, K2 As String, L As Double, M As Long, N As Long, O As Long, Lnum As Long
Dim T As String, P As Long, R As Long, S1 As Double, S2 As Double, W As Long, X As Long, Y As Long
Dim ii As Long, bb As Long, cc As String, nn As Long, ee As Double, gg As Double, Lst As String, pp As Long, rr As Long
Dim Q As Double, S As Double, U As Double, Z As Double, S3 As Double

''' **** For disable each line add  '   symbol to disable that line at code  *****

'' Note: THis remove all ALT+ENTER in The TEXT at the Cell
    Range("A" & Target.Row).Value = Replace(Range("A" & Target.Row).Value, vbLf, "")

T = Range("A" & Target.Row).Value
X = Len(T) - Len(Replace(T, "&", "")) + 1
For M = X To 1 Step -1
  If M < X Then
   Y = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(T, "&", Chr(1), M))
   Range("A" & Target.Row).Characters(Start:=Y, Length:=1).Font.Color = 16777215
  Else
   Y = Len(T)
  End If
   bb = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(Replace(T, "+", "-"), "-", Chr(1), M))
   cc = Trim(Mid(T, bb, 1))
   'cc = Trim(Mid(T, bb, 3))
   '' Note:  THis 3 row changes 1. Font size of symbols  2. Font color of them  3. font color of "&" at the end of line
'   Range("A" & Target.Row).Characters(Start:=bb + 1, Length:=2).Font.Size = 1
'   Range("A" & Target.Row).Characters(Start:=bb + 1, Length:=2).Font.Color = 16777215
'   Range("A" & Target.Row).Characters(Start:=Y, Length:=1).Font.Color = 16777215
   O = bb + 1
For N = O To Y
If Mid(T, N, 1) = " " And IsNumeric(Mid(T, N + 1, 1)) Then P = N + 1
If IsNumeric(Mid(T, N, 1)) Or Mid(T, N, 1) = "." Or Mid(T, N, 1) = "/" Then pp = 1
If Not IsNumeric(Mid(T, N + 1, 1)) Or Mid(T, N + 1, 1) = "." And pp > 0 Then rr = 1
If pp = rr And pp > 0 Then
R = N
If Trim(Mid(T, N + 1, 1)) <> "." Then cc = cc & Trim(Mid(T, N + 2, 1))
'Debug.Print Trim(Mid(T, N + 2, 1))
End If
If Y = N Then GoTo Resum4
If R >= P And P > 0 And Mid(T, N + 1, 1) = " " Or R = Len(T) Then
        If S1 = 0 Then
            S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
            P = 0
            R = 0
        ElseIf S2 = 0 Then
            S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
            P = 0
            R = 0
        Else
            S3 = Mid(Replace(T, "/", "."), P, R - P + 1)
        End If
        If Trim(Mid(T, N + 2, 1)) <> "@" Then
        If Y - N > 8 Then GoTo Resum3
        If Trim(Mid(T, Y - 2, 1)) = "%" Then cc = cc & "%"
        End If
Resum4:
Lnum = 1
                    Select Case cc
                    ''   ******************************************************************************** ''
                    ''  Note: Case is symbols after numbers for Order at Case to calculate Based Case Type

                            Case "-#$$"
                                Z = Z + Round((S1 * S2 / S3), 2) * -1
                            Case "+#$$"
                                U = U + Round((S1 * S2 / S3), 2)
                            Case "+#%"
                                A = A + Round(S1 * (1 + S2 / 100), 2)
                            Case "+#$"
                                B = B + S1 * S2
                                J2 = J2 + S1
                            Case "-#%"
                                C = C + Round(S1 * (1 + S2 / 100) * -1, 2)
                            Case "-#$"
                                D = D + S1 * S2 * -1
                                L = L + S1 * -1
                            Case "+#@"
                                ee = ee + Round((S1 * S2) / 750, 2)
                            Case "-#@"
                                gg = gg + Round(-(S1 * S2) / 750, 2)
                            Case "+$"
                                E = E + S1 * 1
                            Case "+$$"
                                F = F + Round((S1 / S2) * 4.3318, 2)
                            Case "-$"
                                G = G + S1 * -1
                            Case "-$$"
                                H = H + Round((S1 / S2) * -4.3318, 2)
                            Case "+#"
                                 Q = Q + Round(S1, 2)
                            Case "-#"
                                 S = S + Round(S1, 2) * -1
                        End Select
                    '' Note: Because of Case 7 & 9 we have only one number, if change symbol
                    ''       also at the next line should be symbol changes
                    If Lnum = 1 Then
                        S1 = 0
                        S2 = 0
                        S3 = 0
                        P = 0
                        R = 0
                        pp = 0
                        rr = 0
                        Lnum = 0
                        GoTo Resum1
                    End If
              
End If
Resum3:
 pp = 0
 rr = 0
Next N
Resum1:
Next M

'' Notes : Here I add calculated results to cells
Range("D" & Target.Row).Formula = "=Round(" & A & "+" & J2 & "+" & F & "+" & ee & "+" & Q & ", 2)"
Range("E" & Target.Row).Formula = "=Round(" & C & "+" & L & "+" & H & "+" & gg & "+" & S & ", 2)"
Range("F" & Target.Row).Formula = "=" & B & "+" & E
Range("G" & Target.Row).Formula = "=" & D & "+" & G
'' Note: Add again ALT+ENTER to the Text at the Cell
Range("A" & Target.Row).Value = Replace(Range("A" & Target.Row).Value, "&", "&" & vbLf)

'MsgBox "A1 = " & A & vbCr & "B1 = " & J2 & " // " & "B2 = " & B & vbCr & "C1 = " & C & vbCr & "D1 = " & L _
& " // " & "D2 = " & D & vbCr & "E1 = " & E & vbCr & "F1 = " & F & vbCr & "G1 = " & G & vbCr & "H1 = " & _
H & vbCr & "Q1 = " & Q & vbCr & "S1 = " & S & vbCr & "U1 = " & U & vbCr & "Z1 = " & Z



  End If
  For i = 3 To Lr1 - 1
   Cr = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & i).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
   CrR = Range("A" & Cr).Address
     Sheets("Dashboard").Range("I" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Sheets("Dashboard").Range("I" & i), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & CrR, TextToDisplay:=Sheets("Dashboard").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
  Application.EnableEvents = True
End Sub

if you want to add case 13 & 14 to column D & E Change Related line to this:

Range("D" & Target.Row).Formula = "=Round(" & A & "+" & J2 & "+" & F & "+" & ee & "+" & Q &  "+" & U & ", 2)"
Range("E" & Target.Row).Formula = "=Round(" & C & "+" & L & "+" & H & "+" & gg & "+" & S & "+" & Z & ", 2)"

Or if you want to add case 13 & 14 to column F & G Change Related line to this:

Range("F" & Target.Row).Formula = "=" & B & "+" & E "+" & U
Range("G" & Target.Row).Formula = "=" & D & "+" & G "+" & Z