Macro to subtract multiple cells and output the results - excel

Question

I found a macro that subtracts the values in one cell in a workbook from another cell in a workbook to output the result in a final third workbook. It exists as such
Sub Sample()
Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim lngDiff As Long
On Error GoTo Err
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("C:\FirstDataFile.xlsx")
Set wb3 = Workbooks.Open("C:\SecondDataFile.xlsx")
lngDiff = wb2.Sheets("Sheet1").Range("A1").Value - _
wb3.Sheets("Sheet1").Range("A1").Value
wb1.Sheets("Sheet1").Range("A1").Value = lngDiff
wb3.Close savechanges:=False
wb2.Close savechanges:=False
Application.ScreenUpdating = True
Exit Sub
Err:
MsgBox Err.Description
End Sub
Is there anyway to modify this code that it can do this for multiple lines at once.
For example. get it to subtract wb2.Sheets("Sheet1").Range("A1").Value - _
wb3.Sheets("Sheet1").Range("A1").Value and output that result into wb1.Sheets("Sheet1").Range("A1").Value and then do the same for A2, A3 and so on so forth until about A:120000? I would also like to be able to get this done on multiples sheets on the two books that I am drawing info from. How would this be done?
Thanks!

Answer 1

I suggest to use a loop through a list of worksheet names, and outsource the subtraction to subroutine InAllValuesOfColumnA that loops through all rows of each sheet as shown below. I further recommend to use meaningful variable names instead of numbered variables (which is a bad practice and easily gets mixed up).
Option Explicit
Public Sub ExampleSample()
Dim wbResult As Workbook, wbData As Workbook, wbSubtract As Workbook
Dim lngDiff As Long
On Error GoTo Err
Application.ScreenUpdating = False
Set wbResult = ActiveWorkbook
Set wbData = Workbooks.Open("C:\FirstDataFile.xlsx")
Set wbSubtract = Workbooks.Open("C:\SecondDataFile.xlsx")
Dim WorksheetList() As Variant
WorksheetList = Array("Sheet1", "Sheet2") 'add the worksheet names here
Dim WsName As Variant
For Each WsName In WorksheetList
InAllValuesOfColumnA OfWorksheet:=wbData.Worksheets(WsName), SubtractWorksheet:=wbSubtract.Worksheets(WsName), WriteToWorksheet:=wbResult.Worksheets(WsName)
Next WsName
wbData.Close SaveChanges:=False
wbSubtract.Close SaveChanges:=False
Application.ScreenUpdating = True
Exit Sub
Err:
MsgBox Err.Description
End Sub
Private Sub InAllValuesOfColumnA(ByVal OfWorksheet As Worksheet, ByVal SubtractWorksheet As Worksheet, ByVal WriteToWorksheet As Worksheet)
Dim LastRow As Long
LastRow = OfWorksheet.Cells(OfWorksheet.Rows.Count, "A").End(xlUp).Row
Dim iRow As Long
For iRow = 1 To LastRow 'run from first to last row and subtract
WriteToWorksheet.Cells(iRow, "A").Value = CLng(OfWorksheet.Cells(iRow, "A").Value - SubtractWorksheet.Cells(iRow, "A").Value)
Next iRow
End Sub
An even faster way would be to read/write the data into arrays before/after calculation:
Private Sub InAllValuesOfColumnA(ByVal OfWorksheet As Worksheet, ByVal SubtractWorksheet As Worksheet, ByVal WriteToWorksheet As Worksheet)
Dim LastRow As Long
LastRow = OfWorksheet.Cells(OfWorksheet.Rows.Count, "A").End(xlUp).Row
'read all into array
Dim DataColumn() As Variant
DataColumn = OfWorksheet.Range("A1:A" & LastRow).Value
Dim SubtractColumn() As Variant
SubtractColumn = SubtractWorksheet.Range("A1:A" & LastRow).Value
Dim ResultColumn() As Variant
ResultColumn = WriteToWorksheet.Range("A1:A" & LastRow).Value
Dim iRow As Long
For iRow = LBound(ResultColumn) To UBound(ResultColumn) 'run from first to last row and subtract
ResultColumn(iRow) = CLng(DataColumn(iRow) - SubtractColumn(iRow))
Next iRow
WriteToWorksheet.Range("A1:A" & LastRow).Value = ResultColumn
End Sub