VBA or Formula to Subtract Fixed Value from Another Column for Huge Data

[arielina]

Hi,

I have a spreadsheet where for each value in column B (eg B2), I need to subtract it from each of the next 10 value in column A (A3-A12) and reflect each answer in column C (C3-12). I will also need to repeat the same for the next value in column B (B3) and reflect the answers in column D.

This will continue till cell B10000 . So the number of columns to house the subtracted values will go to 10,000 too. I think Excel should be able to have more than 10,000 columns.

Is there a VBA or formula to do this?

Book1.xlsx
	A	B	C	D	E	F
1	In	Out
2	6521	215
3	2532	645	2317
4	3265	342	3050	2620
5	3652	634	3437	3007	3310
6	4684	121	4469	4039	4342	4050
7	5665	342	5450	5020	5323	5031
8	5522	32	5307	4877	5180	4888
9	5536	364	5321	4891	5194	4902
10	3215	634	3000	2570	2873	2581
11	6621	53	6406	5976	6279	5987
12	1232	24	1017	587	890	598
13	5131	24		4486	4789	4497
14	2132	78			1790	1498
15	5612	32			5270	4978
16	9533	342				8899
17	1253	35
18	6521	35
19	2532	12
20	3265	324
21	3652	352
22	4684	215
Sheet3

Cell Formulas
Range	Formula
C3:C12	C3	=A3-B$2
D4:D13	D4	=A4-B$3
E5:E15	E5	=A5-B$4
F6:F16	F6	=A6-B$5

 

[Joe4]

Welcome to the Board!

Try this VBA code:

Sub MyMacro()

    Dim lr As Long
    Dim r As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
'   Set first column to paste to (col "C" is column number 3)
    c = 3
    
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    
'   Loop through all rows starting with row 2
    For r = 2 To lr
'       Populate formula
        Range(Cells(r + 1, c), Cells(r + 10, c)).Formula = "=A" & r + 1 & "-B$" & (c - 1)
'       Increment column counter by 1
        c = c + 1
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[dsehguht]

Here is how you can do it with arrays.
typically i have found that arrays are faster but the loop may make this slow anyway.

Sub arraycascading()

Dim lastrow As Integer, i As Integer, d As Integer
Dim Array_1 As Variant

application.screenupdating = false

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Array_1 = Range("A2:A" & lastrow).Value
For d = 2 To lastrow
    Array_1 = Range("A2:A" & lastrow).Value
   
    For i = 1 To lastrow - 1
    Array_1(i, 1) = Array_1(i, 1) * Cells(d, 2)
    Next
   
Range(Cells(d + 1, d + 1), Cells(d + lastrow - 1, d + 1)) = Array_1
Next

application.screenupdating = true

End Sub

 

[arielina]

Welcome to the Board!

Try this VBA code:

Sub MyMacro()

    Dim lr As Long
    Dim r As Long
    Dim c As Long
   
    Application.ScreenUpdating = False
   
'   Set first column to paste to (col "C" is column number 3)
    c = 3
   
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row
   
'   Loop through all rows starting with row 2
    For r = 2 To lr
'       Populate formula
        Range(Cells(r + 1, c), Cells(r + 10, c)).Formula = "=A" & r + 1 & "-B$" & (c - 1)
'       Increment column counter by 1
        c = c + 1
    Next r
   
    Application.ScreenUpdating = True
   
End Sub

Thanks it works! I missed out to list the requirement to represent the answer as a percentage of the original value, can you help to update the VBA? Updated spreadsheet as follows:

Book1.xlsx
	A	B	C	D	E	F
1	In	Out
2	6521	215
3	2532	645	1077.7%
4	3265	342	1418.6%	406.2%
5	3652	634	1598.6%	466.2%	967.8%
6	4684	121	2078.6%	626.2%	1269.6%	638.8%
7	5665	342	2534.9%	778.3%	1556.4%	793.5%
8	5522	32	2468.4%	756.1%	1514.6%	771.0%
9	5536	364	2474.9%	758.3%	1518.7%	773.2%
10	3215	634	1395.3%	398.4%	840.1%	407.1%
11	6621	53	2979.5%	926.5%	1836.0%	944.3%
12	1232	24	473.0%	91.0%	260.2%	94.3%
13	5131	24		695.5%	1400.3%	709.3%
14	2132	78			523.4%	236.3%
15	5612	32			1540.9%	785.2%
16	9533	342				1403.6%
17	1253	35
18	6521	35
19	2532	12
20	3265	324
21	3652	352
22	4684	215
Sheet3

Cell Formulas
Range	Formula
C3:C12	C3	=(A3-B$2)/B$2
D4:D13	D4	=(A4-B$3)/B$3
E5:E15	E5	=(A5-B$4)/B$4
F6:F16	F6	=(A6-B$5)/B$5

 

[arielina]

Here is how you can do it with arrays.
typically i have found that arrays are faster but the loop may make this slow anyway.

Sub arraycascading()

Dim lastrow As Integer, i As Integer, d As Integer
Dim Array_1 As Variant

application.screenupdating = false

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Array_1 = Range("A2:A" & lastrow).Value
For d = 2 To lastrow
    Array_1 = Range("A2:A" & lastrow).Value
  
    For i = 1 To lastrow - 1
    Array_1(i, 1) = Array_1(i, 1) * Cells(d, 2)
    Next
  
Range(Cells(d + 1, d + 1), Cells(d + lastrow - 1, d + 1)) = Array_1
Next

application.screenupdating = true

End Sub

Thanks. I need subtracted values instead of mutiplied ones which you have provided.

 

[Joe4]

Thanks it works! I missed out to list the requirement to represent the answer as a percentage of the original value, can you help to update the VBA? Updated spreadsheet as follows:

Book1.xlsx
	A	B	C	D	E	F
1	In	Out
2	6521	215
3	2532	645	1077.7%
4	3265	342	1418.6%	406.2%
5	3652	634	1598.6%	466.2%	967.8%
6	4684	121	2078.6%	626.2%	1269.6%	638.8%
7	5665	342	2534.9%	778.3%	1556.4%	793.5%
8	5522	32	2468.4%	756.1%	1514.6%	771.0%
9	5536	364	2474.9%	758.3%	1518.7%	773.2%
10	3215	634	1395.3%	398.4%	840.1%	407.1%
11	6621	53	2979.5%	926.5%	1836.0%	944.3%
12	1232	24	473.0%	91.0%	260.2%	94.3%
13	5131	24		695.5%	1400.3%	709.3%
14	2132	78			523.4%	236.3%
15	5612	32			1540.9%	785.2%
16	9533	342				1403.6%
17	1253	35
18	6521	35
19	2532	12
20	3265	324
21	3652	352
22	4684	215
Sheet3

Cell Formulas
Range	Formula
C3:C12	C3	=(A3-B$2)/B$2
D4:D13	D4	=(A4-B$3)/B$3
E5:E15	E5	=(A5-B$4)/B$4
F6:F16	F6	=(A6-B$5)/B$5

That is easy enough. Just add in a line to format the range you just populated, i.e.

Sub MyMacro()

    Dim lr As Long
    Dim r As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
'   Set first column to paste to (col "C" is column number 3)
    c = 3
    
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    
'   Loop through all rows starting with row 2
    For r = 2 To lr
'       Populate formula
        Range(Cells(r + 1, c), Cells(r + 10, c)).Formula = "=A" & r + 1 & "-B$" & (c - 1)
'       Format cells
        Range(Cells(r + 1, c), Cells(r + 10, c)).NumberFormat = "0.0%"
'       Increment column counter by 1
        c = c + 1
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[arielina]

That is easy enough. Just add in a line to format the range you just populated, i.e.

Sub MyMacro()

    Dim lr As Long
    Dim r As Long
    Dim c As Long
   
    Application.ScreenUpdating = False
   
'   Set first column to paste to (col "C" is column number 3)
    c = 3
   
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row
   
'   Loop through all rows starting with row 2
    For r = 2 To lr
'       Populate formula
        Range(Cells(r + 1, c), Cells(r + 10, c)).Formula = "=A" & r + 1 & "-B$" & (c - 1)
'       Format cells
        Range(Cells(r + 1, c), Cells(r + 10, c)).NumberFormat = "0.0%"
'       Increment column counter by 1
        c = c + 1
    Next r
   
    Application.ScreenUpdating = True
   
End Sub

Sorry I think I am not being clear. If you look at the updated formula in cell C3, it has been updated to be divided by B$2. Similarly for the rest of the cells, all need to be divided by the original value and then formatted as a percentage. Thanks.

 

[Joe4]

Sorry I think I am not being clear. If you look at the updated formula in cell C3, it has been updated to be divided by B$2. Similarly for the rest of the cells, all need to be divided by the original value and then formatted as a percentage. Thanks.

OK, I am not sure why you didn't show us what you really wanted from the start, seeing as how you even went through all the trouble of posting an example in your original post.
But try this:

Sub MyMacro()

    Dim lr As Long
    Dim r As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
'   Set first column to paste to (col "C" is column number 3)
    c = 3
    
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    
'   Loop through all rows starting with row 2
    For r = 2 To lr
'       Populate formula
        Range(Cells(r + 1, c), Cells(r + 10, c)).Formula = "=(A" & r + 1 & "-B$" & (c - 1) & ")/B$" & (c - 1)
'       Format cells
        Range(Cells(r + 1, c), Cells(r + 10, c)).NumberFormat = "0.0%"
'       Increment column counter by 1
        c = c + 1
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[johnnyL]

Here is an array version I came up with that is very fast

Sub arielina_V1()
'
    Dim StartTime               As Double
    StartTime = Timer
'
    Dim ArrayColumn             As Long
    Dim ArrayRow                As Long
    Dim ColumnARow              As Long
    Dim ColumnBRow              As Long
    Dim LoopCount               As Long
    Dim ColumnANumbersArray     As Variant
    Dim ColumnBNumbersArray     As Variant
    Dim ResultArray()           As Variant
    Dim TempValue               As Variant
'
    ColumnANumbersArray = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    ColumnBNumbersArray = Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row - 10)
'
'  Check if ResultArray is an array
    If Not IsArray(ColumnBNumbersArray) Then
'  Convert inputVariable to a 2D array
        TempValue = ColumnBNumbersArray
        ReDim ColumnBNumbersArray(1 To 1, 1 To 1)
        ColumnBNumbersArray(1, 1) = TempValue
    End If
'
    ReDim ResultArray(1 To UBound(ColumnBNumbersArray, 1) + 11, 1 To UBound(ColumnBNumbersArray, 1))
'
'    End If
'
    For ArrayColumn = LBound(ColumnBNumbersArray, 1) To UBound(ColumnBNumbersArray, 1)
        ColumnARow = ArrayColumn + 1
        ColumnBRow = ColumnBRow + 1
'
        For LoopCount = 1 To 10
            ColumnARow = ColumnARow + 1
            ResultArray(ColumnARow, ArrayColumn) = FormatPercent((ColumnANumbersArray(ColumnARow, 1) - ColumnBNumbersArray(ColumnBRow, 1)) / ColumnBNumbersArray(ColumnBRow, 1), 1)
        Next
    Next
'
    Range("C1").Resize(UBound(ResultArray, 1), UBound(ResultArray, 2)) = ResultArray
'
    ActiveSheet.UsedRange.EntireColumn.AutoFit
Debug.Print "Time to complete = " & Timer - StartTime & "seconds."
MsgBox "Time to complete = " & Timer - StartTime & "seconds."

End Sub

 

[johnnyL]

Hmmm. After some testing, it appears the the codes offered in post #8 & post #9 run at about the same speed.