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
maabadi said:
I think you don't need alphabet at the first of cases.
Try this for numbering Correctly:
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, Lr3 As Long, Lr4 As Long, K As Long
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, M1 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, M2 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, qq As Long, ss As Long, tt 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
  Application.ScreenUpdating = False
  Application.FindFormat.Clear
  Application.FindFormat.Interior.Color = 14277081
  M2 = Sheets("Work").Range("A1:A" & Rows.Count).Find("", , , , , xlPrevious, , , True).Row
'    Rows(M2 + 1 & ":" & Rows.Count).Hidden = False
  If Target.Interior.Color = 14277081 Then
  If Target.Value <> "" Then
  If IsNumeric(Target.Value) And Target.Value > 0 Then
  Sheets("Work").Rows(M2 + 1).Resize(Target.Value).Hidden = False
  Range("A" & Target.Row & ":G" & Target.Row + Target.Value - 1).Insert Shift:=xlDown
  End If
  Target.Value = ""
  End If
  ElseIf Target.Interior.Color = 16777215 Then
T = Replace(Range("A" & Target.Row).Value, vbLf, "")
X = Len(T) - Len(Replace(T, "&", "")) + 1
For M = 1 To X
bb = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(Replace(T, "+", "-"), "-", Chr(1), M))
If Mid(T, bb - 1, 1) = M Then GoTo NextF
Debug.Print Mid(T, bb - 1, 1)
T = Left(T, bb - 1) & M & Right(T, Len(T) - bb + 1)
NextF:
Next M
Debug.Print T
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))
   O = bb + 1
   Lst = Mid(T, O, Y - O + 1)
   On Error Resume Next
   ff = Application.WorksheetFunction.Find("@", Lst)
   pp = Application.WorksheetFunction.Find("#", Lst)
   qq = Application.WorksheetFunction.Find("$", Lst)
   ss = Application.WorksheetFunction.Find("%", Lst)
   tt = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(Lst, "$", Chr(1), 2))
   On Error GoTo 0
   If pp > 0 Then cc = cc & "#"
   If qq > 0 Then cc = cc & "$"
   If tt > 0 Then cc = cc & "$"
   If ff > 0 Then cc = cc & "@"
   If ss > 0 Then cc = cc & "%"
   Debug.Print T
   Lst = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Lst, 9, 0), 8, 0), 7, 0), 6, 0), 5, 0), 4, 0), 3, 0), 2, 0), 1, 0)
   rr = Application.WorksheetFunction.Find(0, Lst)


                    Select Case cc
                            Case "-#$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                Z = Z + Round(S1 + (S1 * S2 / S3 * 4.3318), 2) * -1
                            Case "+#$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                U = U + Round(S1 + (S1 * S2 / S3 * 4.3318), 2)
                            Case "+#%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                A = A + Round(S1 * (1 + S2 / 100), 2)
                            Case "+#$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                B = B + S1 * S2
                                J2 = J2 + S1
                            Case "-#%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                C = C + Round(S1 * (1 + S2 / 100) * -1, 2)
                            Case "-#$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                D = D + S1 * S2 * -1
                                L = L + S1 * -1
                            Case "+#@"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                On Error Resume Next
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ff - rr))
                                If S2 = 0 Then
                                ss = InStr(rr + 2, Lst, " ")
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                End If
                                ee = ee + Round((S1 * S2) / 750, 2)
                            Case "-#@"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                On Error Resume Next
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ff - rr))
                                If S2 = 0 Then
                                ss = InStr(rr + 2, Lst, " ")
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                End If
                                gg = gg + Round(-(S1 * S2) / 750, 2)
                            Case "+$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                E = E + S1 * 1
                            Case "+$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                F = F + Round((S1 / S2) * 4.3318, 2)
                            Case "-$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                G = G + S1 * -1
                            Case "-$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                H = H + Round((S1 / S2) * -4.3318, 2)
                            Case "+#"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                Q = Q + Round(S1, 2)
                            Case "-#"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                S = S + Round(S1, 2) * -1
                            Case "-#$%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                rr = InStr(ss + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                Z = Z + Round(S1 + (S1 * S2 / 100), 2) * -1
                                D = D + S1 * S3 * -1
                            Case "+#$%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                rr = InStr(ss + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                U = U + Round(S1 + (S1 * S2 / 100), 2)
                                B = B + S1 * S3
                        End Select
ff = 0
pp = 0
qq = 0
rr = 0
tt = 0
ss = 0
S1 = 0
S2 = 0
S3 = 0
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(T, "&", "&" & 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
  Application.FindFormat.Interior.Color = 14277081
  For i = 3 To Lr1 - 1
    M1 = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & i), Sheets("Work").Range("A1:A" & Lr3 + 100), 0) + 2
    M = Sheets("Work").Range("A" & M1 & ":A" & Lr3 + 100).Find("", , , , , xlNext, , , True).Row - 1
    Sheets("Dashboard").Range("J" & i).Formula = "=Work!B" & M
    Sheets("Dashboard").Range("K" & i).Formula = "=SUM(Work!D" & M1 & ":E" & M & ")"
    Sheets("Dashboard").Range("L" & i).Formula = "=SUM(Work!F" & M1 & ":G" & M & ")"
   Cr = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & i).Value, Sheets("Work").Range("A1:A" & Lr3 + 20), 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
'  M2 = Sheets("Work").Range("A" & Lr3 + 2 & ":A" & Rows.Count - 100).Find("", , , , , xlPrevious, , , True).Row
'    Rows(M2 + 1 & ":" & Rows.Count).Hidden = True
  Application.FindFormat.Clear
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub
Click to expand...
it does correctly! Thanks...
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
maabadi said:
.
Click to expand...
Hi again maabadi
another thing that make problem for work, i use insert sheet rows and delete sheet rows button in ribbon and with this code i not test it recently but i use them and make problem for code that didn't work and wrong alignment (in edit cell) even i set it again, show this error:
 

Attachments

  • Annotation 2021-11-05 231649.png
    Annotation 2021-11-05 231649.png
    5.3 KB · Views: 5
  • Annotation 2021-11-05 231655.png
    Annotation 2021-11-05 231655.png
    36.2 KB · Views: 5
Upvote 0
this problem occurs because it doesn't find number at cell. try this to ignore cell when insert or delete 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, Lr3 As Long, Lr4 As Long, K As Long
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, M1 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, M2 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, qq As Long, ss As Long, tt 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
  Application.ScreenUpdating = False
  Application.FindFormat.Clear
  Application.FindFormat.Interior.Color = 14277081
  M2 = Sheets("Work").Range("A1:A" & Rows.Count).Find("", , , , , xlPrevious, , , True).Row
'    Rows(M2 + 1 & ":" & Rows.Count).Hidden = False
  If Target.Interior.Color = 14277081 Then
  If Target.Value <> "" Then
  If IsNumeric(Target.Value) And Target.Value > 0 Then
  Sheets("Work").Rows(M2 + 1).Resize(Target.Value).Hidden = False
  Range("A" & Target.Row & ":G" & Target.Row + Target.Value - 1).Insert Shift:=xlDown
  End If
  Target.Value = ""
  End If
  ElseIf Target.Interior.Color = 16777215 Then
T = Replace(Range("A" & Target.Row).Value, vbLf, "")
X = Len(T) - Len(Replace(T, "&", "")) + 1
For M = 1 To X
bb = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(Replace(T, "+", "-"), "-", Chr(1), M))
If Mid(T, bb - 1, 1) = M Then GoTo NextF
Debug.Print Mid(T, bb - 1, 1)
T = Left(T, bb - 1) & M & Right(T, Len(T) - bb + 1)
NextF:
Next M
Debug.Print T
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))
   O = bb + 1
   Lst = Mid(T, O, Y - O + 1)
   On Error Resume Next
   ff = Application.WorksheetFunction.Find("@", Lst)
   pp = Application.WorksheetFunction.Find("#", Lst)
   qq = Application.WorksheetFunction.Find("$", Lst)
   ss = Application.WorksheetFunction.Find("%", Lst)
   tt = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(Lst, "$", Chr(1), 2))
   On Error GoTo 0
   If pp > 0 Then cc = cc & "#"
   If qq > 0 Then cc = cc & "$"
   If tt > 0 Then cc = cc & "$"
   If ff > 0 Then cc = cc & "@"
   If ss > 0 Then cc = cc & "%"
   Debug.Print T
   Lst = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Lst, 9, 0), 8, 0), 7, 0), 6, 0), 5, 0), 4, 0), 3, 0), 2, 0), 1, 0)
On Error goto Resum9  
 rr = Application.WorksheetFunction.Find(0, Lst)


                    Select Case cc
                            Case "-#$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                Z = Z + Round(S1 + (S1 * S2 / S3 * 4.3318), 2) * -1
                            Case "+#$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                U = U + Round(S1 + (S1 * S2 / S3 * 4.3318), 2)
                            Case "+#%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                A = A + Round(S1 * (1 + S2 / 100), 2)
                            Case "+#$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                B = B + S1 * S2
                                J2 = J2 + S1
                            Case "-#%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                C = C + Round(S1 * (1 + S2 / 100) * -1, 2)
                            Case "-#$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                D = D + S1 * S2 * -1
                                L = L + S1 * -1
                            Case "+#@"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                On Error Resume Next
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ff - rr))
                                If S2 = 0 Then
                                ss = InStr(rr + 2, Lst, " ")
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                End If
                                ee = ee + Round((S1 * S2) / 750, 2)
                            Case "-#@"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                On Error Resume Next
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ff - rr))
                                If S2 = 0 Then
                                ss = InStr(rr + 2, Lst, " ")
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                End If
                                gg = gg + Round(-(S1 * S2) / 750, 2)
                            Case "+$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                E = E + S1 * 1
                            Case "+$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                F = F + Round((S1 / S2) * 4.3318, 2)
                            Case "-$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                G = G + S1 * -1
                            Case "-$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                H = H + Round((S1 / S2) * -4.3318, 2)
                            Case "+#"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                Q = Q + Round(S1, 2)
                            Case "-#"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                S = S + Round(S1, 2) * -1
                            Case "-#$%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                rr = InStr(ss + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                Z = Z + Round(S1 + (S1 * S2 / 100), 2) * -1
                                D = D + S1 * S3 * -1
                            Case "+#$%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                rr = InStr(ss + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                U = U + Round(S1 + (S1 * S2 / 100), 2)
                                B = B + S1 * S3
                        End Select
ff = 0
pp = 0
qq = 0
rr = 0
tt = 0
ss = 0
S1 = 0
S2 = 0
S3 = 0
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(T, "&", "&" & 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
Resum9:
  Application.FindFormat.Interior.Color = 14277081
  For i = 3 To Lr1 - 1
    M1 = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & i), Sheets("Work").Range("A1:A" & Lr3 + 100), 0) + 2
    M = Sheets("Work").Range("A" & M1 & ":A" & Lr3 + 100).Find("", , , , , xlNext, , , True).Row - 1
    Sheets("Dashboard").Range("J" & i).Formula = "=Work!B" & M
    Sheets("Dashboard").Range("K" & i).Formula = "=SUM(Work!D" & M1 & ":E" & M & ")"
    Sheets("Dashboard").Range("L" & i).Formula = "=SUM(Work!F" & M1 & ":G" & M & ")"
   Cr = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & i).Value, Sheets("Work").Range("A1:A" & Lr3 + 20), 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
'  M2 = Sheets("Work").Range("A" & Lr3 + 2 & ":A" & Rows.Count - 100).Find("", , , , , xlPrevious, , , True).Row
'    Rows(M2 + 1 & ":" & Rows.Count).Hidden = True
  Application.FindFormat.Clear
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub
 
Upvote 0
maabadi said:
this problem occurs because it doesn't find number at cell. try this to ignore cell when insert or delete 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, Lr3 As Long, Lr4 As Long, K As Long
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, M1 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, M2 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, qq As Long, ss As Long, tt 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
  Application.ScreenUpdating = False
  Application.FindFormat.Clear
  Application.FindFormat.Interior.Color = 14277081
  M2 = Sheets("Work").Range("A1:A" & Rows.Count).Find("", , , , , xlPrevious, , , True).Row
'    Rows(M2 + 1 & ":" & Rows.Count).Hidden = False
  If Target.Interior.Color = 14277081 Then
  If Target.Value <> "" Then
  If IsNumeric(Target.Value) And Target.Value > 0 Then
  Sheets("Work").Rows(M2 + 1).Resize(Target.Value).Hidden = False
  Range("A" & Target.Row & ":G" & Target.Row + Target.Value - 1).Insert Shift:=xlDown
  End If
  Target.Value = ""
  End If
  ElseIf Target.Interior.Color = 16777215 Then
T = Replace(Range("A" & Target.Row).Value, vbLf, "")
X = Len(T) - Len(Replace(T, "&", "")) + 1
For M = 1 To X
bb = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(Replace(T, "+", "-"), "-", Chr(1), M))
If Mid(T, bb - 1, 1) = M Then GoTo NextF
Debug.Print Mid(T, bb - 1, 1)
T = Left(T, bb - 1) & M & Right(T, Len(T) - bb + 1)
NextF:
Next M
Debug.Print T
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))
   O = bb + 1
   Lst = Mid(T, O, Y - O + 1)
   On Error Resume Next
   ff = Application.WorksheetFunction.Find("@", Lst)
   pp = Application.WorksheetFunction.Find("#", Lst)
   qq = Application.WorksheetFunction.Find("$", Lst)
   ss = Application.WorksheetFunction.Find("%", Lst)
   tt = Application.WorksheetFunction.Find(Chr(1), Application.WorksheetFunction.Substitute(Lst, "$", Chr(1), 2))
   On Error GoTo 0
   If pp > 0 Then cc = cc & "#"
   If qq > 0 Then cc = cc & "$"
   If tt > 0 Then cc = cc & "$"
   If ff > 0 Then cc = cc & "@"
   If ss > 0 Then cc = cc & "%"
   Debug.Print T
   Lst = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Lst, 9, 0), 8, 0), 7, 0), 6, 0), 5, 0), 4, 0), 3, 0), 2, 0), 1, 0)
On Error goto Resum9 
 rr = Application.WorksheetFunction.Find(0, Lst)


                    Select Case cc
                            Case "-#$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                Z = Z + Round(S1 + (S1 * S2 / S3 * 4.3318), 2) * -1
                            Case "+#$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                U = U + Round(S1 + (S1 * S2 / S3 * 4.3318), 2)
                            Case "+#%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                A = A + Round(S1 * (1 + S2 / 100), 2)
                            Case "+#$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                B = B + S1 * S2
                                J2 = J2 + S1
                            Case "-#%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                C = C + Round(S1 * (1 + S2 / 100) * -1, 2)
                            Case "-#$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                D = D + S1 * S2 * -1
                                L = L + S1 * -1
                            Case "+#@"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                On Error Resume Next
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ff - rr))
                                If S2 = 0 Then
                                ss = InStr(rr + 2, Lst, " ")
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                End If
                                ee = ee + Round((S1 * S2) / 750, 2)
                            Case "-#@"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                On Error Resume Next
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ff - rr))
                                If S2 = 0 Then
                                ss = InStr(rr + 2, Lst, " ")
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                End If
                                gg = gg + Round(-(S1 * S2) / 750, 2)
                            Case "+$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                E = E + S1 * 1
                            Case "+$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                F = F + Round((S1 / S2) * 4.3318, 2)
                            Case "-$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                G = G + S1 * -1
                            Case "-$$"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                rr = InStr(qq + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, tt - rr))
                                H = H + Round((S1 / S2) * -4.3318, 2)
                            Case "+#"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                Q = Q + Round(S1, 2)
                            Case "-#"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                S = S + Round(S1, 2) * -1
                            Case "-#$%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                rr = InStr(ss + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                Z = Z + Round(S1 + (S1 * S2 / 100), 2) * -1
                                D = D + S1 * S3 * -1
                            Case "+#$%"
                                S1 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, pp - rr))
                                rr = InStr(pp + 1, Lst, 0)
                                S2 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, ss - rr))
                                rr = InStr(ss + 1, Lst, 0)
                                S3 = Trim(Mid(Replace(T, "/", "."), O + rr - 1, qq - rr))
                                U = U + Round(S1 + (S1 * S2 / 100), 2)
                                B = B + S1 * S3
                        End Select
ff = 0
pp = 0
qq = 0
rr = 0
tt = 0
ss = 0
S1 = 0
S2 = 0
S3 = 0
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(T, "&", "&" & 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
Resum9:
  Application.FindFormat.Interior.Color = 14277081
  For i = 3 To Lr1 - 1
    M1 = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & i), Sheets("Work").Range("A1:A" & Lr3 + 100), 0) + 2
    M = Sheets("Work").Range("A" & M1 & ":A" & Lr3 + 100).Find("", , , , , xlNext, , , True).Row - 1
    Sheets("Dashboard").Range("J" & i).Formula = "=Work!B" & M
    Sheets("Dashboard").Range("K" & i).Formula = "=SUM(Work!D" & M1 & ":E" & M & ")"
    Sheets("Dashboard").Range("L" & i).Formula = "=SUM(Work!F" & M1 & ":G" & M & ")"
   Cr = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & i).Value, Sheets("Work").Range("A1:A" & Lr3 + 20), 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
'  M2 = Sheets("Work").Range("A" & Lr3 + 2 & ":A" & Rows.Count - 100).Find("", , , , , xlPrevious, , , True).Row
'    Rows(M2 + 1 & ":" & Rows.Count).Hidden = True
  Application.FindFormat.Clear
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub
Click to expand...
understand, this is ignored and solved, awesome, Thank You
 
Upvote 0
and another thing, for prevent repeat insert list number, this worked until 9 and after that, numbers are repeat with two digits...
 
Upvote 0
Change this line:

VBA Code: 
If Mid(T, bb - 1, 1) = M Then GoTo NextF

TO

VBA Code: 
If Trim(Mid(T, bb - 2, 2)) = M Then GoTo NextF
 
Upvote 0
maabadi said:
.
Click to expand...
Hi again maabadi
i have problem with scroll down that till end row excel, and you try for hidden rows except cutomers (empty rows after last customer, i mean for example for this example file, without customer hidden all rows, after create customers, unhide rows for customer and when insert rows, not customer data going to hidden rows), anyway to do this?
example file: Book T=T.rar
 
Upvote 0
1. if only problem is scroll down. do it with CTRL+ down Arrow. with hiding and unhiding macro run slowly.
2. if you persist to do it with macro, which sheet you want to hide rows on it?
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Analytics Project - Sumifs
Replies
1
Views
220
bobaol
B
S
  • Solved
Calculating Multiple Columns with SUMIFS
Replies
3
Views
195
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
163
roelandwatteeuw
R
M
  • Solved
How to sum a row of data with some cells containing an extra character
2
Replies
10
Views
696
Fluff
Fluff
N
  • Solved
Sum a range of cells defined by a string
Replies
4
Views
199
Nerdio
N

Forum statistics

Threads
1,214,919
Messages
6,122,260
Members
449,075
Latest member
staticfluids

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