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
First I change your inputted data to fit to my code ( you see it at second column of image).
I use + sign (as second symbol) for Positive numbers Result (pay) and - sign (as second symbol) for Negative value and try the same format only different at + with - have same first symbol.
After running code you see result at left column of image but it has one more empty row between each case. if your cases at inputted data at cell don't separate with ALT+ENTER Then code works correct and after end of case replace / with ALT+ENTER.

This is Worksheet change code for WORK sheet :
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 Long, 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 = Mid(T, bb - 1, 2)

   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
                            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
                    If S2 > 0 Or cc = "$+" Or cc = "$-" Then
                        S1 = 0
                        S2 = 0
                        P = 0
                        R = 0
                        T = Application.WorksheetFunction.Substitute(T, cc, "")
                        Range("A" & Target.Row) = T
                        GoTo Resum1
                    End If
                End If
End If

 pp = 0
 rr = 0
Next N
Resum1:
Next M
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
T = Application.WorksheetFunction.Substitute(T, "/", vbCr)
Range("A" & Target.Row) = T
'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


1234.jpg
 
Last edited:
Upvote 0

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
maabadi said:
First I change your inputted data to fit to my code ( you see it at second column of image).
I use + sign (as second symbol) for Positive numbers Result (pay) and - sign (as second symbol) for Negative value and try the same format only different at + with - have same first symbol.
After running code you see result at left column of image but it has one more empty row between each case. if your cases at inputted data at cell don't separate with ALT+ENTER Then code works correct and after end of case replace / with ALT+ENTER.

This is Worksheet change code for WORK sheet :
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 Long, 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 = Mid(T, bb - 1, 2)

   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
                            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
                    If S2 > 0 Or cc = "$+" Or cc = "$-" Then
                        S1 = 0
                        S2 = 0
                        P = 0
                        R = 0
                        T = Application.WorksheetFunction.Substitute(T, cc, "")
                        Range("A" & Target.Row) = T
                        GoTo Resum1
                    End If
                End If
End If

 pp = 0
 rr = 0
Next N
Resum1:
Next M
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
T = Application.WorksheetFunction.Substitute(T, "/", vbCr)
Range("A" & Target.Row) = T
'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


View attachment 45247
Click to expand...
i test, but
Unexpc said:
one thing, i write with this order
1-
2-
3-
...
and at first the code find this order and front of each number add alphabetic, for example find 1 and add A and for 2 add B, this is stable order and not change, after that run calculation and then delete alphabetic, i think when i want change a number then press enter, this steps repeat and no need i write specific things again for a change
Click to expand...
if this will be work, for a change in each case after i write it, because may need change after i entered factor in sheet for a few days later and i should write again this symbols to do calculation again, but if this work, no need this steps, i write list number and write each cases then like this
maabadi said:
1A-
2C-
3B-
Click to expand...
maabadi said:
using English alphabet for Case Type: A , B, C , D , E , ...
Click to expand...
maabadi said:
about using capital letter for pay (positive numbers) : A , B , C , D and for difference small letters for Negative numbers: a , b , c , d , ....
Click to expand...
but i for separate + and - value, i write like this
1+
2-
3+
4+
5+
6-
and continue
Unexpc said:
at first the code find this order and front of each number add alphabetic, for example find 1 and add A and for 2 add B, this is stable order and not change, after that run calculation and then delete alphabetic, i think when i want change a number then press enter, this steps repeat and no need i write specific things again for a change
Click to expand...
for delete, no need delete + and - just delete alphabetic, because for change if this symbols (+and-) i should write this again, so just delete alphabetic, because that is find and automatic write letters before calculation
again thank you for spent your time :)
 
Upvote 0
I don't understand exactly.
1. You want to use for example:
1A+
2C-
3B+
And so on.
2.what about you don't write numbers for order and I added numbers after running code when delete symbols?
3. Please show image of example you say
 
Upvote 0
maabadi said:
what about you don't write numbers for order and I added numbers after running code when delete symbols?
Click to expand...
no problem with write numbers for order like photo and i write + or - for values of formats, then code first find this order numbers and for 1 added A front of 1 and for 2 added B and for 3 added C and... for each number that have specific alphabet after that number, then calculation and after that just delete alphabet letters, this letters for separate between cases that have same format like you suggestion before
 

Attachments

  • image_2021-08-20_155515.png
    image_2021-08-20_155515.png
    11.9 KB · Views: 5
  • image_2021-08-20_155522.png
    image_2021-08-20_155522.png
    12.4 KB · Views: 5
Upvote 0
Unexpc said:
then code first find this order numbers and for 1 added A front of 1 and for 2 added B and for 3 added C and... for each number that have specific alphabet after that number
Click to expand...
1. if you write numbers as Persian letters can't use at VBA code.
2. with second format at input ( with English alphabet) we can use at inputting. Are you want numbers as order or Case Type?
3. if you used as case type and English Format for numbers you don't need English alphabet at all.

Please give me one exact format to start working on it and write code based on.
Formats suggested:
1+ , 2+ , 3- , .... for Case type ( Numbers inputted as English Format)
1A+ , 2B+ , 3C- , English letters used as Case type and numbers can input at Persian Format. Also English Letters can delete after code runs
My Symbol used at last image uploaded.
 
Upvote 0
maabadi said:
1. if you write numbers as Persian letters can't use at VBA code.
2. with second format at input ( with English alphabet) we can use at inputting. Are you want numbers as order or Case Type?
3. if you used as case type and English Format for numbers you don't need English alphabet at all.

Please give me one exact format to start working on it and write code based on.
Formats suggested:
1+ , 2+ , 3- , .... for Case type ( Numbers inputted as English Format)
1A+ , 2B+ , 3C- , English letters used as Case type and numbers can input at Persian Format. Also English Letters can delete after code runs
My Symbol used at last image uploaded.
Click to expand...
the problem with written number when language switched in persian?
have difference number between language? i mean have different value between english number and persian number?
maabadi said:
Are you want numbers as order or Case Type
Click to expand...
as order that separate each case that same formats
 
Last edited:
Upvote 0
Unexpc said:
no problem with write numbers for order like photo and i write + or - for values of formats, then code first find this order numbers and for 1 added A front of 1 and for 2 added B and for 3 added C and... for each number that have specific alphabet after that number, then calculation and after that just delete alphabet letters, this letters for separate between cases that have same format like you suggestion before
Click to expand...
please say all problems
 
Upvote 0
you want a definition or define a symbol as a format for each format, am i right?
please say how the code that find cases and find different between cases that have same format
that is just need specific symbols?
 
Upvote 0
maabadi said:
1A+ , 2B+ , 3C- , English letters used as Case type and numbers can input at Persian Format. Also English Letters can delete after code runs
Click to expand...
1. What about this type? ( the same format with persian numbers can use also.)
2. If you want result at excel only, why you don't use B Fonts ( B nazanin, B mitra, B Lotus, B roya , ...). This fonts shows numbers as persian also if write as English format.
3. Until you don't give me exact format, I cannot work on code.
 
Upvote 0
maabadi said:
If you want result at excel only, why you don't use B Fonts ( B nazanin, B mitra, B Lotus, B roya , ...). This fonts shows numbers as persian also if write as English format.
Click to expand...
this font i send you not this work?
maabadi said:
What about this type? ( the same format with persian numbers can use also.)
Click to expand...
that i say you automatic write english alphabetic, but you mean i write them that each number and letter define a specific format type
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Analytics Project - Sumifs
Replies
1
Views
325
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
132
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
335
roelandwatteeuw
R

Forum statistics

Threads
1,216,222
Messages
6,129,586
Members
449,520
Latest member
TBFrieds

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