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

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
OK. Then I need your excel file with this format to know exact what is this?
I think I can know it with Chr function.
Please upload excel file with these last example.
 
Upvote 0
Also try this macro.
Attention: this macro work only for data at Cell A3.
VBA Code: 
Sub FindValues()
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 I As String, J As Double, K 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 Long, nn As Long, ee As Long, gg As Long, Lst As Long, pp As Long, rr As Long
T = Range("A3").Value
X = Len(T) - Len(Replace(T, "&", "")) + 1
For M = 1 To X
If M > 1 Then W = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(T, "&", Chr(1), M - 1))
  If M < X Then
   Y = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(T, "&", Chr(1), M))
  Else
   Y = Len(T)
  End If
    On Error GoTo ErrHandler
        bb = Application.WorksheetFunction.Find("@", Mid(T, W + 1, Y - W))
        
ErrHandler:
    If Err.Number = 1004 Then
        bb = Application.WorksheetFunction.Find("!", Mid(T, W + 1, Y - W))
        
        Err.Clear
        Resume Resum
    End If
Resum:
   On Error GoTo ErrHandler2
        cc = Application.WorksheetFunction.Find("$", Mid(T, W + 1, Y - W))
        
ErrHandler2:
    If Err.Number = 1004 Then
        cc = Application.WorksheetFunction.Find("#", Mid(T, W + 1, Y - W))
        
        On Error GoTo 0
        Resume Resum2
    End If
Resum2:
   On Error GoTo ErrHandler3
        gg = Application.WorksheetFunction.Find("%", Mid(T, W + 1, Y - W))
        gg = 1
ErrHandler3:
    If Err.Number = 1004 Then
        gg = 2
        On Error GoTo 0
        Resume Resum3
    End If
Resum3:
I = Mid(T, W + bb, 1)
K = Mid(T, W + cc, 1)
O = W + 4
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 = 0 And P > 0 And ee = 0 Then
N = N + 1
ee = 1
End If
If R >= P And P > 0 And Mid(T, N + 1, 1) = " " Or R = Len(T) Then
  If I = "!" Then
    If K = "#" Then
        If S1 = 0 Then
            S1 = Mid(T, P, R - P + 1)
            P = 0
            R = 0
            ee = 0
        Else
            S2 = Mid(T, P, R - P + 1)
        End If
        If S2 <> S1 And S2 > 0 Then
            If gg = 1 Then
            A = S1 * (1 + S2 / 100)
            Else
            B = S1 * S2
            J = S1
            End If
            
        S1 = 0
        S2 = 0
        P = 0
        R = 0
        ee = 0
        GoTo Resum1
        End If
    ElseIf K = "$" Then
    Lst = 0
    For nn = 0 To 9
     Lst = InStrRev(Left(T, Y), nn)
     If Lst > 0 Then Exit For
    Next nn
         If R = Lst And S1 = 0 Then
              E = Mid(T, P, R - P + 1) * 1
              P = 0
              R = 0
              ee = 0
              GoTo Resum1
             
         Else
            
                If S1 = 0 Then
                S1 = Mid(T, P, R - P + 1)
                Else
                S2 = Mid(T, P, R - P + 1)
                End If
            
            If S2 <> S1 And S2 > 0 Then
             F = (S1 / S2) * 4.3318
             S1 = 0
             S2 = 0
             P = 0
             R = 0
             ee = 0
             GoTo Resum1
            End If
         End If
    End If
 ElseIf I = "@" Then
    If K = "#" Then
        
            If S1 = 0 Then
            S1 = Mid(T, P, R - P + 1)
            Else
            S2 = Mid(T, P, R - P + 1)
            End If
        
        If S2 <> S1 And S2 > 0 Then
            If gg = 1 Then
            C = S1 * (1 + S2 / 100) * -1
            Else
            D = S1 * S2 * -1
            L = S1 * -1
            End If
         S1 = 0
         S2 = 0
         P = 0
         R = 0
         ee = 0
         GoTo Resum1
        End If
    ElseIf K = "$" Then
        Lst = 0
        For nn = 0 To 9
            Lst = InStrRev(Left(T, Y), nn)
            If Lst > 0 Then Exit For
        Next nn
         If R = Lst And S1 = 0 Then
              G = Mid(T, P, R - P + 1) * -1
              P = 0
              R = 0
              ee = 0
              GoTo Resum1
             
        Else
            
                If S1 = 0 Then
                S1 = Mid(T, P, R - P + 1)
                Else
                S2 = Mid(T, P, R - P + 1)
                End If
            
            If S2 <> S1 And S2 > 0 Then
             H = (S1 / S2) * -4.3318
             S1 = 0
             S2 = 0
             P = 0
             R = 0
             ee = 0
             GoTo Resum1
            End If
        End If
    End If
 End If
 End If
 pp = 0
 rr = 0
Next N
Resum1:
Next M
Range("D3").Value = Round(A + J + F, 3)
Range("E3").Value = Round(C + L + H, 3)
Range("F3").Value = B + E
Range("G3").Value = D + G

'MsgBox "A1 = " & A & vbCr & "B1 = " & J & " // " & "B2 = " & B & vbCr & "C1 = " & C & vbCr & "D1 = " & L & " // " & "D2 = " & D _
& vbCr & "E1 = " & E & vbCr & "F1 = " & F & vbCr & "G1 = " & G & vbCr & "H1 = " & H
End Sub
 
Upvote 0
Also Test this for A3 Cell:
VBA Code: 
Sub FindValues()
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 I As String, J As Double, K 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 Long, nn As Long, ee As Long, gg As Long, Lst As Long, pp As Long, rr As Long
T = Range("A3").Value
X = Len(T) - Len(Replace(T, "&", "")) + 1
For M = 1 To X
If M > 1 Then W = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(T, "&", Chr(1), M - 1))
  If M < X Then
   Y = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(T, "&", Chr(1), M))
  Else
   Y = Len(T)
  End If
    On Error GoTo ErrHandler
        bb = Application.WorksheetFunction.Find("@", Mid(T, W + 1, Y - W))
        
ErrHandler:
    If Err.Number = 1004 Then
        bb = Application.WorksheetFunction.Find("!", Mid(T, W + 1, Y - W))
        
        Err.Clear
        Resume Resum
    End If
Resum:
   On Error GoTo ErrHandler2
        cc = Application.WorksheetFunction.Find("$", Mid(T, W + 1, Y - W))
        
ErrHandler2:
    If Err.Number = 1004 Then
        cc = Application.WorksheetFunction.Find("#", Mid(T, W + 1, Y - W))
        
        On Error GoTo 0
        Resume Resum2
    End If
Resum2:
   On Error GoTo ErrHandler3
        gg = Application.WorksheetFunction.Find("%", Mid(T, W + 1, Y - W))
        gg = 1
ErrHandler3:
    If Err.Number = 1004 Then
        gg = 2
        On Error GoTo 0
        Resume Resum3
    End If
Resum3:
I = Mid(T, W + bb, 1)
K = Mid(T, W + cc, 1)
O = W + 4
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 = 0 And P > 0 And ee = 0 Then
N = N + 1
ee = 1
End If
If R >= P And P > 0 And Mid(T, N + 1, 1) = " " Or R = Len(T) Then
  If I = "!" Then
    If K = "#" Then
        If S1 = 0 Then
            S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
            P = 0
            R = 0
            ee = 0
        Else
            S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
        End If
        If S2 <> S1 And S2 > 0 Then
            If gg = 1 Then
            A = S1 * (1 + S2 / 100)
            Else
            B = S1 * S2
            J = S1
            End If
            
        S1 = 0
        S2 = 0
        P = 0
        R = 0
        ee = 0
        GoTo Resum1
        End If
    ElseIf K = "$" Then
    Lst = 0
    For nn = 0 To 9
     Lst = InStrRev(Left(T, Y), nn)
     If Lst > 0 Then Exit For
    Next nn
         If R = Lst And S1 = 0 Then
              E = Mid(Replace(T, "/", "."), P, R - P + 1) * 1
              P = 0
              R = 0
              ee = 0
              GoTo Resum1
             
         Else
            
                If S1 = 0 Then
                S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
                Else
                S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
                End If
            
            If S2 <> S1 And S2 > 0 Then
             F = (S1 / S2) * 4.3318
             S1 = 0
             S2 = 0
             P = 0
             R = 0
             ee = 0
             GoTo Resum1
            End If
         End If
    End If
 ElseIf I = "@" Then
    If K = "#" Then
        
            If S1 = 0 Then
            S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
            Else
            S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
            End If
        
        If S2 <> S1 And S2 > 0 Then
            If gg = 1 Then
            C = S1 * (1 + S2 / 100) * -1
            Else
            D = S1 * S2 * -1
            L = S1 * -1
            End If
         S1 = 0
         S2 = 0
         P = 0
         R = 0
         ee = 0
         GoTo Resum1
        End If
    ElseIf K = "$" Then
        Lst = 0
        For nn = 0 To 9
            Lst = InStrRev(Left(T, Y), nn)
            If Lst > 0 Then Exit For
        Next nn
         If R = Lst And S1 = 0 Then
              G = Mid(Replace(T, "/", "."), P, R - P + 1) * -1
              P = 0
              R = 0
              ee = 0
              GoTo Resum1
             
        Else
            
                If S1 = 0 Then
                S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
                Else
                S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
                End If
            
            If S2 <> S1 And S2 > 0 Then
             H = (S1 / S2) * -4.3318
             S1 = 0
             S2 = 0
             P = 0
             R = 0
             ee = 0
             GoTo Resum1
            End If
        End If
    End If
 End If
 End If
 pp = 0
 rr = 0
Next N
Resum1:
Next M
Range("D3").Value = Round(A + J + F, 3)
Range("E3").Value = Round(C + L + H, 3)
Range("F3").Value = B + E
Range("G3").Value = D + G

'MsgBox "A1 = " & A & vbCr & "B1 = " & J & " // " & "B2 = " & B & vbCr & "C1 = " & C & vbCr & "D1 = " & L & " // " & "D2 = " & D _
& vbCr & "E1 = " & E & vbCr & "F1 = " & F & vbCr & "G1 = " & G & vbCr & "H1 = " & H
End Sub
 
Upvote 0
maabadi said:
OK. Then I need your excel file with this format to know exact what is this?
I think I can know it with Chr function.
Please upload excel file with these last example.
Click to expand...
i test two codes, but does'nt work
and my file with example: Book.xlsm
 
Upvote 0
I see your file and add code to that. I see two problems:
1. you forgot add & to end of each case.
2. at your worksheet change event macro, Delete Lr4 line because you don't have Paper sheet at this excel file & see error.

this is your file with modifications:
Book1.xlsm
 
Upvote 0
maabadi said:
1. you forgot add & to end of each case.
Click to expand...
Yes, i copy from previous book file and i forget add &, sorry
maabadi said:
2. at your worksheet change event macro, Delete Lr4 line because you don't have Paper sheet at this excel file & see error.
Click to expand...
i add paper sheet to example file
maabadi said:
this is your file with modifications:
Book1.xlsm
Click to expand...
and i test, but not calculate and give results...
my example file with paper:
drive.google.com

Book 1.xlsm

drive.google.com drive.google.com
 
Upvote 0
Unexpc said:
but not calculate and give results...
Click to expand...
You want also calculation step also. I think you want only result.
Change macro to this:
VBA Code: 
Sub FindValues()
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 I As String, J As Double, K 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 Long, nn As Long, ee As Long, gg As Long, Lst As Long, pp As Long, rr As Long
T = Range("A3").Value
X = Len(T) - Len(Replace(T, "&", "")) + 1
For M = 1 To X
If M > 1 Then W = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(T, "&", Chr(1), M - 1))
  If M < X Then
   Y = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(T, "&", Chr(1), M))
  Else
   Y = Len(T)
  End If
    On Error GoTo ErrHandler
        bb = Application.WorksheetFunction.Find("@", Mid(T, W + 1, Y - W))
        
ErrHandler:
    If Err.Number = 1004 Then
        bb = Application.WorksheetFunction.Find("!", Mid(T, W + 1, Y - W))
        
        Err.Clear
        Resume Resum
    End If
Resum:
   On Error GoTo ErrHandler2
        cc = Application.WorksheetFunction.Find("$", Mid(T, W + 1, Y - W))
        
ErrHandler2:
    If Err.Number = 1004 Then
        cc = Application.WorksheetFunction.Find("#", Mid(T, W + 1, Y - W))
        
        On Error GoTo 0
        Resume Resum2
    End If
Resum2:
   On Error GoTo ErrHandler3
        gg = Application.WorksheetFunction.Find("%", Mid(T, W + 1, Y - W))
        gg = 1
ErrHandler3:
    If Err.Number = 1004 Then
        gg = 2
        On Error GoTo 0
        Resume Resum3
    End If
Resum3:
I = Mid(T, W + bb, 1)
K = Mid(T, W + cc, 1)
O = W + 4
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 = 0 And P > 0 And ee = 0 Then
N = N + 1
ee = 1
End If
If R >= P And P > 0 And Mid(T, N + 1, 1) = " " Or R = Len(T) Then
  If I = "!" Then
    If K = "#" Then
        If S1 = 0 Then
            S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
            P = 0
            R = 0
            ee = 0
        Else
            S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
        End If
        If S2 <> S1 And S2 > 0 Then
            If gg = 1 Then
            A = S1 * (1 + S2 / 100)
            Else
            B = S1 * S2
            J = S1
            End If
            
        S1 = 0
        S2 = 0
        P = 0
        R = 0
        ee = 0
        GoTo Resum1
        End If
    ElseIf K = "$" Then
    Lst = 0
    For nn = 0 To 9
     Lst = InStrRev(Left(T, Y), nn)
     If Lst > 0 Then Exit For
    Next nn
         If R = Lst And S1 = 0 Then
              E = Mid(Replace(T, "/", "."), P, R - P + 1) * 1
              P = 0
              R = 0
              ee = 0
              GoTo Resum1
             
         Else
            
                If S1 = 0 Then
                S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
                Else
                S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
                End If
            
            If S2 <> S1 And S2 > 0 Then
             F = (S1 / S2) * 4.3318
             S1 = 0
             S2 = 0
             P = 0
             R = 0
             ee = 0
             GoTo Resum1
            End If
         End If
    End If
 ElseIf I = "@" Then
    If K = "#" Then
        
            If S1 = 0 Then
            S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
            Else
            S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
            End If
        
        If S2 <> S1 And S2 > 0 Then
            If gg = 1 Then
            C = S1 * (1 + S2 / 100) * -1
            Else
            D = S1 * S2 * -1
            L = S1 * -1
            End If
         S1 = 0
         S2 = 0
         P = 0
         R = 0
         ee = 0
         GoTo Resum1
        End If
    ElseIf K = "$" Then
        Lst = 0
        For nn = 0 To 9
            Lst = InStrRev(Left(T, Y), nn)
            If Lst > 0 Then Exit For
        Next nn
         If R = Lst And S1 = 0 Then
              G = Mid(Replace(T, "/", "."), P, R - P + 1) * -1
              P = 0
              R = 0
              ee = 0
              GoTo Resum1
             
        Else
            
                If S1 = 0 Then
                S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
                Else
                S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
                End If
            
            If S2 <> S1 And S2 > 0 Then
             H = (S1 / S2) * -4.3318
             S1 = 0
             S2 = 0
             P = 0
             R = 0
             ee = 0
             GoTo Resum1
            End If
        End If
    End If
 End If
 End If
 pp = 0
 rr = 0
Next N
Resum1:
Next M
Range("D3").Formula = "=Round(" & A & "+" & J & "+" & F & ", 3)"
Range("E3").Formula = "=Round(" & C & "+" & L & "+" & H & ", 3)"
Range("F3").Formula = "=" & B & "+" & E
Range("G3").Formula = "=" & D & "+" & G

'MsgBox "A1 = " & A & vbCr & "B1 = " & J & " // " & "B2 = " & B & vbCr & "C1 = " & C & vbCr & "D1 = " & L & " // " & "D2 = " & D _
& vbCr & "E1 = " & E & vbCr & "F1 = " & F & vbCr & "G1 = " & G & vbCr & "H1 = " & H
End Sub
 
Upvote 0
maabadi said:
You want also calculation step also. I think you want only result.
Change macro to this:
VBA Code: 
Sub FindValues()
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 I As String, J As Double, K 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 Long, nn As Long, ee As Long, gg As Long, Lst As Long, pp As Long, rr As Long
T = Range("A3").Value
X = Len(T) - Len(Replace(T, "&", "")) + 1
For M = 1 To X
If M > 1 Then W = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(T, "&", Chr(1), M - 1))
  If M < X Then
   Y = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(T, "&", Chr(1), M))
  Else
   Y = Len(T)
  End If
    On Error GoTo ErrHandler
        bb = Application.WorksheetFunction.Find("@", Mid(T, W + 1, Y - W))
       
ErrHandler:
    If Err.Number = 1004 Then
        bb = Application.WorksheetFunction.Find("!", Mid(T, W + 1, Y - W))
       
        Err.Clear
        Resume Resum
    End If
Resum:
   On Error GoTo ErrHandler2
        cc = Application.WorksheetFunction.Find("$", Mid(T, W + 1, Y - W))
       
ErrHandler2:
    If Err.Number = 1004 Then
        cc = Application.WorksheetFunction.Find("#", Mid(T, W + 1, Y - W))
       
        On Error GoTo 0
        Resume Resum2
    End If
Resum2:
   On Error GoTo ErrHandler3
        gg = Application.WorksheetFunction.Find("%", Mid(T, W + 1, Y - W))
        gg = 1
ErrHandler3:
    If Err.Number = 1004 Then
        gg = 2
        On Error GoTo 0
        Resume Resum3
    End If
Resum3:
I = Mid(T, W + bb, 1)
K = Mid(T, W + cc, 1)
O = W + 4
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 = 0 And P > 0 And ee = 0 Then
N = N + 1
ee = 1
End If
If R >= P And P > 0 And Mid(T, N + 1, 1) = " " Or R = Len(T) Then
  If I = "!" Then
    If K = "#" Then
        If S1 = 0 Then
            S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
            P = 0
            R = 0
            ee = 0
        Else
            S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
        End If
        If S2 <> S1 And S2 > 0 Then
            If gg = 1 Then
            A = S1 * (1 + S2 / 100)
            Else
            B = S1 * S2
            J = S1
            End If
           
        S1 = 0
        S2 = 0
        P = 0
        R = 0
        ee = 0
        GoTo Resum1
        End If
    ElseIf K = "$" Then
    Lst = 0
    For nn = 0 To 9
     Lst = InStrRev(Left(T, Y), nn)
     If Lst > 0 Then Exit For
    Next nn
         If R = Lst And S1 = 0 Then
              E = Mid(Replace(T, "/", "."), P, R - P + 1) * 1
              P = 0
              R = 0
              ee = 0
              GoTo Resum1
            
         Else
           
                If S1 = 0 Then
                S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
                Else
                S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
                End If
           
            If S2 <> S1 And S2 > 0 Then
             F = (S1 / S2) * 4.3318
             S1 = 0
             S2 = 0
             P = 0
             R = 0
             ee = 0
             GoTo Resum1
            End If
         End If
    End If
 ElseIf I = "@" Then
    If K = "#" Then
       
            If S1 = 0 Then
            S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
            Else
            S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
            End If
       
        If S2 <> S1 And S2 > 0 Then
            If gg = 1 Then
            C = S1 * (1 + S2 / 100) * -1
            Else
            D = S1 * S2 * -1
            L = S1 * -1
            End If
         S1 = 0
         S2 = 0
         P = 0
         R = 0
         ee = 0
         GoTo Resum1
        End If
    ElseIf K = "$" Then
        Lst = 0
        For nn = 0 To 9
            Lst = InStrRev(Left(T, Y), nn)
            If Lst > 0 Then Exit For
        Next nn
         If R = Lst And S1 = 0 Then
              G = Mid(Replace(T, "/", "."), P, R - P + 1) * -1
              P = 0
              R = 0
              ee = 0
              GoTo Resum1
            
        Else
           
                If S1 = 0 Then
                S1 = Mid(Replace(T, "/", "."), P, R - P + 1)
                Else
                S2 = Mid(Replace(T, "/", "."), P, R - P + 1)
                End If
           
            If S2 <> S1 And S2 > 0 Then
             H = (S1 / S2) * -4.3318
             S1 = 0
             S2 = 0
             P = 0
             R = 0
             ee = 0
             GoTo Resum1
            End If
        End If
    End If
 End If
 End If
 pp = 0
 rr = 0
Next N
Resum1:
Next M
Range("D3").Formula = "=Round(" & A & "+" & J & "+" & F & ", 3)"
Range("E3").Formula = "=Round(" & C & "+" & L & "+" & H & ", 3)"
Range("F3").Formula = "=" & B & "+" & E
Range("G3").Formula = "=" & D & "+" & G

'MsgBox "A1 = " & A & vbCr & "B1 = " & J & " // " & "B2 = " & B & vbCr & "C1 = " & C & vbCr & "D1 = " & L & " // " & "D2 = " & D _
& vbCr & "E1 = " & E & vbCr & "F1 = " & F & vbCr & "G1 = " & G & vbCr & "H1 = " & H
End Sub
Click to expand...
not work, not any result in D3,E3,F3,G3
 
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
330
roelandwatteeuw
R

Forum statistics

Threads
1,216,180
Messages
6,129,347
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