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: 26
Sort by date Sort by votes
Then the best method we can use is:
You write Numbers as Case Type then Plus or Minus Sign (+ or -). Then I use them at factor to define case type then delete numbers and add numbers for order. Then your inputted format should be:
1+
3-
2+
....
After running code result is:
1+
2-
3+
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
maabadi said:
Until you don't give me exact format
Click to expand...
i think you are define each format type and the problem is just for limit use each format for twice or more... but i say to you a symbol or more that define each case, sorry i thought this is passed :) i think more about that we choice better solution, but still have a problem, when i write symbols as a format type and then calculation and the delete this symbols, when i want later change a number, i should write all of this symbols again, have idea about this?
 
Upvote 0
Unexpc said:
when i want later change a number, i should write all of this symbols again, have idea about this?
Click to expand...
We can add them with running code at cells at empty columns.
Then with one normal separate code we can back symbols to data at that cell.
 
Upvote 0
maabadi said:
We can add them with running code at cells at empty columns.
Then with one normal separate code we can back symbols to data at that cell.
Click to expand...
one thing, can add automatically number list order? for example when i write + at first in a cell, excel shows a error and i should not use any calculation symbol, so you know i use a number or text
this is the file formats:Book T=.xlsm
and please highlight all this symbols in code that when i want change them, i can do that
 
Upvote 0
because of Worksheet change event macro, whenever you change dat at cells at column A the Macro automatically runs to calculate cases and give result.
Then if don't find exact format it show error.
At this situation, you can only change data at column A based case format defined.
OR Change format at other column then paste final at Column A.
Unexpc said:
please highlight all this symbols in code that when i want change them, i can do that
Click to expand...
OK. I work on it. Please Clarify also how you want to see format of column A after code runs.
Show with image if possible.
 
Upvote 0
maabadi said:
Please Clarify also how you want to see format of column A after code runs.
Click to expand...
maabadi said:
because of Worksheet change event macro, whenever you change dat at cells at column A the Macro automatically runs to calculate cases and give result.
Then if don't find exact format it show error.
Click to expand...
 

Attachments

  • image_2021-08-21_084319.png
    image_2021-08-21_084319.png
    11.9 KB · Views: 4
  • image_2021-08-21_084403.png
    image_2021-08-21_084403.png
    9 KB · Views: 4
Upvote 0
I think you don't want & symbol at the end of each case, But I see it at the image for result.
 
Upvote 0
maabadi said:
I think you don't want & symbol at the end of each case, But I see it at the image for result.
Click to expand...
sorry, you are right
and another question, can i write & in end of each case and then automatic alt+enter between cases?
 
Upvote 0
Unexpc said:
can i write & in end of each case and then automatic alt+enter between cases?
Click to expand...
If you don't add ALT+ENTER at the First Data and all data write at one line, Then I can Replace & Symbol with Next Line Character at VBA.
For Now based uploaded file format ( without Replaced & with ALT+ENTER):
This is Worksheet Change event Macro for WORK Sheet:
And symbols pasted at Column I and the Same Row
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
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))
  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))
   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
                        '' Notes : At the Next line, I add symbols to one defined Character
                        Lst = Right(cc, Len(cc) - 1) & " /" & Lst
                        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
'' Notes: at the Next 3 lines I replaced symbols and then deleted symbols added to column I at the same row.
T = Replace(Replace(Replace(Replace(Replace(T, "$", ""), "#%", ""), "#", ""), "@", ""), "&", "")
Range("A" & Target.Row) = T
Range("I" & Target.Row) = Application.WorksheetFunction.Substitute(Lst, "/", vbCrLf)
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
 
Upvote 0
maabadi said:
If you don't add ALT+ENTER at the First Data and all data write at one line, Then I can Replace & Symbol with Next Line Character at VBA.
For Now based uploaded file format ( without Replaced & with ALT+ENTER):
This is Worksheet Change event Macro for WORK Sheet:
And symbols pasted at Column I and the Same Row
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
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))
  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))
   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
                        '' Notes : At the Next line, I add symbols to one defined Character
                        Lst = Right(cc, Len(cc) - 1) & " /" & Lst
                        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
'' Notes: at the Next 3 lines I replaced symbols and then deleted symbols added to column I at the same row.
T = Replace(Replace(Replace(Replace(Replace(T, "$", ""), "#%", ""), "#", ""), "@", ""), "&", "")
Range("A" & Target.Row) = T
Range("I" & Target.Row) = Application.WorksheetFunction.Substitute(Lst, "/", vbCrLf)
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
Click to expand...
8 not calculate in D
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Analytics Project - Sumifs
Replies
1
Views
323
bobaol
B
S
  • Solved
Calculating Multiple Columns with SUMIFS
Replies
3
Views
288
Joe4
Joe4
B
  • Question
Excel 2021 - Sum cells that contain text for total and total by month
Replies
1
Views
131
bebo021999
B
K
  • Solved
Question Only? why one vba code works and another wont, even though should have same results.
Replies
3
Views
128
MARK858
MARK858
R
  • Solved
Connect periods with spilled result, where the result is same as the calculated result in previous row
2
Replies
15
Views
331
roelandwatteeuw
R

Forum statistics

Threads
1,216,182
Messages
6,129,360
Members
449,506
Latest member
nomvula

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