VBA code to produce substracted result

[Wafee]

Hi,

Can someone help me with VBA code that does the following.
There will be three types of values in. They are numbers, percentage and fractions. For numbers and percentages it has to subtract and produce the output. for fractions it has to subtract above and below values separately and produce the output.

As shown below, in fractions it has take above values from both and substarct them and then do the same for below values.

Column A	Column B	Column C
50	60	10
65%	50%	-5%
73/65	78/60	5/-5
62/70	60/65	-2/-5

 

[Peter_SSs]

Are the original values actual numbers or text?
Does this user-defined function do what you want?

Function Subtr(r1 As Range, r2 As Range) As Variant
  Select Case True
    Case InStr(1, r1.Text, "/") > 0
      Subtr = (Split(r2.Text, "/")(0) - Split(r1.Text, "/")(0)) & "/" & (Split(r2.Text, "/")(1) - Split(r1.Text, "/")(1))
    Case Right(r1.Text, 1) = "%"
      Subtr = Format(r2 - r1, "0.0%")
    Case Else
      Subtr = r2 - r1
  End Select
End Function

Wafee 2020-08-20 1.xlsm
	A	B	C
1	50	60	10
2	65%	50%	-15.0%
3	73/65	78/60	5/-5
4	62/70	60/65	-2/-5
Subtract

Cell Formulas
Range	Formula
C1:C4	C1	=Subtr(A1,B1)

 

[Wafee]

Are the original values actual numbers or text?
Does this user-defined function do what you want?

Function Subtr(r1 As Range, r2 As Range) As Variant
  Select Case True
    Case InStr(1, r1.Text, "/") > 0
      Subtr = (Split(r2.Text, "/")(0) - Split(r1.Text, "/")(0)) & "/" & (Split(r2.Text, "/")(1) - Split(r1.Text, "/")(1))
    Case Right(r1.Text, 1) = "%"
      Subtr = Format(r2 - r1, "0.0%")
    Case Else
      Subtr = r2 - r1
  End Select
End Function

Wafee 2020-08-20 1.xlsm
	A	B	C
1	50	60	10
2	65%	50%	-15.0%
3	73/65	78/60	5/-5
4	62/70	60/65	-2/-5
Subtract

Cell Formulas
Range	Formula
C1:C4	C1	=Subtr(A1,B1)

Hi Peter,

Original data will have both text and numbers. The function you have provide should do but can you help me with the code that does the above action using values in A and B column and produces result in C. It should do until last row of data. Thank you in advance.

 

[Peter_SSs]

can you help me with the code that does the above action using values in A and B column and produces result in C. It should do until last row of data.

Try this with a copy of your workbook.

Sub SubtractThem()
  Dim r As Range
  Dim s1 As String, s2 As String
  
  Application.ScreenUpdating = False
  For Each r In Range("A2", Range("A" & Rows.Count).End(xlUp))
      s1 = r.Text
      s2 = r.Offset(, 1).Text
      Select Case True
        Case InStr(1, s1, "/") > 0
          r.Offset(, 2).Value = (Split(s2, "/")(0) - Split(s1, "/")(0)) & "/" & (Split(s2, "/")(1) - Split(s1, "/")(1))
        Case Right(s1, 1) = "%"
          r.Offset(, 2).Value = (Split(s2, "%")(0) - Split(s1, "%")(0)) & "%"
        Case IsNumeric(s1)
          r.Offset(, 2).Value = s2 - s1
      End Select
  Next r
  Application.ScreenUpdating = True
End Sub

 

[Wafee]

t

Try this with a copy of your workbook.

Sub SubtractThem()
  Dim r As Range
  Dim s1 As String, s2 As String
 
  Application.ScreenUpdating = False
  For Each r In Range("A2", Range("A" & Rows.Count).End(xlUp))
      s1 = r.Text
      s2 = r.Offset(, 1).Text
      Select Case True
        Case InStr(1, s1, "/") > 0
          r.Offset(, 2).Value = (Split(s2, "/")(0) - Split(s1, "/")(0)) & "/" & (Split(s2, "/")(1) - Split(s1, "/")(1))
        Case Right(s1, 1) = "%"
          r.Offset(, 2).Value = (Split(s2, "%")(0) - Split(s1, "%")(0)) & "%"
        Case IsNumeric(s1)
          r.Offset(, 2).Value = s2 - s1
      End Select
  Next r
  Application.ScreenUpdating = True
End Sub

This perfectly works, thank you

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.

 

[Wafee]

You're welcome. Thanks for the follow-up.

Hi Peter,

Can you help me with two more requirements with the above code!!
1. Need a line of code that does the subtraction for 3 numbers which are in the format 50/60/70. (Eg: result for 50/60/70 and 55/58/72 should be 5/-2/2)

2. I have few headers in the middle of the sheet with names as "Past(column A)" and "Present(column B)". The code should ignore these headers while doing the substraction. These will be be there in A and B columns in multiple places.

Thank you in advance.

 

[Peter_SSs]

Need a line of code that does the subtraction for 3 numbers which are in the format 50/60/70

Is this a separate question or are such values mixed up among the 2-number values like below?

The code would already ignore any header rows (unless those header values contained a "/" or "%" character).

Wafee 2020-08-20 1.xlsm
	A	B
2	50	60
3	65%	50%
4	73/65	78/60
5	50/60/70	55/58/72
6	62/70	60/65
Subtract

 

[Wafee]

Is this a separate question or are such values mixed up among the 2-number values like below?

The code would already ignore any header rows (unless those header values contained a "/" or "%" character).

Wafee 2020-08-20 1.xlsm
	A	B
2	50	60
3	65%	50%
4	73/65	78/60
5	50/60/70	55/58/72
6	62/70	60/65
Subtract

That's right, it is mixed up among 2 number values.

 

[Peter_SSs]

Then try this one. Should work for any number of "/" terms. eg 45/85/42/55/21 and 40/22/60/15/88

Sub SubtractThem_v2()
  Dim r As Range
  Dim s1 As String, s2 As String, s As String
  Dim Bits1 As Variant, Bits2 As Variant
  Dim i As Long

  Application.ScreenUpdating = False
  For Each r In Range("A2", Range("A" & Rows.Count).End(xlUp))
      s1 = r.Text
      s2 = r.Offset(, 1).Text
      Select Case True
        Case InStr(1, s1, "/") > 0
          Bits1 = Split(s1, "/")
          Bits2 = Split(s2, "/")
          s = vbNullString
          For i = 0 To UBound(Bits1)
            s = s & "/" & (Bits2(i) - Bits1(i))
          Next i
          r.Offset(, 2).Value = Mid(s, 2)
        Case Right(s1, 1) = "%"
          r.Offset(, 2).Value = (Split(s2, "%")(0) - Split(s1, "%")(0)) & "%"
        Case IsNumeric(s1)
          r.Offset(, 2).Value = s2 - s1
      End Select
  Next r
  Application.ScreenUpdating = True
End Sub

Wafee 2020-08-20 1.xlsm
	A	B	C
1
2	50	60	10
3	65%	50%	-15%
4	73/65	78/60	5/-5
5	Past	Present
6	50/60/70	55/58/72	5/-2/2
7	62/70	60/65	-2/-5
8	20%	20%	0%
9	45/85/42/55/21	40/22/60/15/88	-5/-63/18/-40/67
Subtract