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

U

Unexpc

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

Attachments

  • image_2021-07-16_183906.png
    image_2021-07-16_183906.png
    20.9 KB · Views: 24
Sort by date Sort by votes

Attachments

  • image_2021-09-16_130627.png
    image_2021-09-16_130627.png
    2 KB · Views: 5
Last edited:
Upvote 0

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
maabadi said:
if you want to add case 13 & 14 to column D & E Change Related line to this:
VBA Code: 
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)"
Click to expand...
this is correct? (for D and E)
VBA 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
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 &  "+" & U & ", 2)"
Range("E" & Target.Row).Formula = "=Round(" & C & "+" & L & "+" & H & "+" & gg & "+" & S & "+" & Z & ", 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
 
Upvote 0
Yes Code it correct.
But for @ you can add words but you should use @ after Number.
Or another Symbol different than others after Number
Then I change code based On.

Also I Work on this format to find way. Please Wait until tommorrow.
 
Upvote 0
maabadi said:
Yes Code it correct.
But for @ you can add words but you should use @ after Number.
Or another Symbol different than others after Number
Then I change code based On.

Also I Work on this format to find way. Please Wait until tommorrow.
Click to expand...
for third number? for because that not in calculation and not find that for a number, comma that use? or i don't know if find way please say about
and i wait, thank you for spent your time, this format is awesome to use
 
Last edited:
Upvote 0
I tell again
maabadi said:
Remember always you need have space before and after Numbers and Symbols. (case 1 need correction at this new example)
Click to expand...
also check other cases
after first time running and see message box, if you see one of values zero, you should correct related case for Space
if you don't see zero values for next time if you don't want to see Message box add ' at the first of 3 lines of MsgBox
This is code without need to relocation @ at Text.
VBA 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
Dim Q As Double, S As Double, U As Double, Z As Double, S3 As Double, ff 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, 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
   ff = Application.WorksheetFunction.Find("@", Mid(T, O, Y - O))
   'If ff > 0 Then Debug.Print ff
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 ff = 0 Then
        If Y - N > 8 Then GoTo Resum3
        If Trim(Mid(T, Y - 2, 1)) = "%" Then cc = cc & "%"
        Else
        If S2 > 0 Then
        cc = Left(cc, 2) & "@"
        Else
        GoTo Resum3
        End If
        End If
Resum4:

Debug.Print cc
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
                        ff = 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 & "+" & U & ", 2)"
Range("E" & Target.Row).Formula = "=Round(" & C & "+" & L & "+" & H & "+" & gg & "+" & S & "+" & Z & ", 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
 
Upvote 0
maabadi said:
I tell again
also check other cases
Click to expand...
i know that, between every number and symbol should be a space, i ask for @ before second number, if you mean that @ after first number and should have space, so not any problem
for case 1 i add words between them for this need
and i test this code, something is wrong, i write a line that worked but i write second line after that with & between them, calculate 0
maabadi said:
after first time running and see message box, if you see one of values zero, you should correct related case for Space
if you don't see zero values for next time if you don't want to see Message box add ' at the first of 3 lines of MsgBox
Click to expand...
this related about i say? i checked and correct spaces and everything
maabadi said:
This is code without need to relocation @ at Text.
Click to expand...
i don't understand for relocation @ at text...
the photo that text i want for @
 

Attachments

  • image_2021-09-16_235948.png
    image_2021-09-16_235948.png
    2 KB · Views: 5
Upvote 0
The code works with the first new formats you wants without modifications.
Also don't need add symbol for 3rd number at case 5 and 6.
Format same as that I posted at Post 130 but you should change @ before 2nd number that you wants.
 
Upvote 0
maabadi said:
The code works with the first new formats you wants without modifications.
Click to expand...
yes, you are right, the space between last symbol of each case and & should write word between them and space not separate them, i write words and doing correct :) this happen for case 1 that you say i not understand what you mean exactly i think no problem with just use space with symbols, that should write words between each symbols, this is right? and space not enough for separate symbols...
maabadi said:
Format same as that I posted at Post 130 but you should change @ before 2nd number that you wants.
Click to expand...
yes this is work correctly too
 
Upvote 0
maabadi said:
The code works with the first new formats you wants without modifications.
Also don't need add symbol for 3rd number at case 5 and 6.
Format same as that I posted at Post 130 but you should change @ before 2nd number that you wants.
Click to expand...
and another thing, can automatic list number for line i write? when the first word in a cell is + or - excel shows an error that not allowed confirm, anyway when i enter before that add list number and then confirm?
maabadi said:
The code works with the first new formats you wants without modifications.
Click to expand...
You were right, this actually work sorry again, i thought space is enough for space between symbols, but should write words between them and it became that i wrong
 
Upvote 0
No Problem. You can list with numbers because i don't use numbers for determining Case type.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Analytics Project - Sumifs
Replies
1
Views
227
bobaol
B
S
  • Solved
Calculating Multiple Columns with SUMIFS
Replies
3
Views
200
Joe4
Joe4
R
  • Solved
Connect periods with spilled result, where the result is same as the calculated result in previous row
2
Replies
15
Views
168
roelandwatteeuw
R
M
  • Solved
How to sum a row of data with some cells containing an extra character
2
Replies
10
Views
700
Fluff
Fluff
N
  • Solved
Sum a range of cells defined by a string
Replies
4
Views
200
Nerdio
N

Forum statistics

Threads
1,214,990
Messages
6,122,625
Members
449,093
Latest member
catterz66

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