Macro in VBA for excel that processes large quantities of data - excel

Question

I need some help with a particular macro I am working on.
The macro processes columns of data that have been imported from a pdf file. The import process produces multiple sheets of consistent data, all variables stay in the same columns across multiple sheets. This macro needs to read the three columns of numbers, subtract all cells in two columns one from another, place solved value in an empty column at the end of each row. Then repeat with another combination of two columns. After that, it needs to compare the solved values against a margin value, and generate a new sheet that pulls the whole row of data that the failed margin value is in to a new sheet at the front of the workbook.
This is what I have so far.
I can preform the function on one sheet so far, but don't know how to automate this to the other sheets. Numbers populate columns B, C, and D, Answers should be placed in G, H and any other columns after H are empty.
Private Sub FindAndCreateSheet3dBm()
' Declare variables
Dim eWs As Worksheet
Dim rMargin As Range
Dim myUnion As Range
'Column G: subrtact max and measured values
Worksheets("page 6").Range("G1:G21").Formula = "=(C1-D1)"
'*need to fix sheet reference, make all sheets, add flexible range to
'end of G range
'Column H: subrtact measured and min values
Worksheets("page 6").Range("H1:H21").Formula = "=(D1-B1)"
'*need to fix sheet reference, make all sheets, add flexible range to
'end of H range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Create the report sheet at first position then name it "Less than 3dBm"
Dim wsReport As Worksheet
Dim rCellwsReport As Range
Set wsReport = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1))
wsReport.Name = "Less than 3dBm"
Set rCellwsReport = wsReport.Cells(1, 1)
'Create union of columns to search G and H?
Set myUnion = Union(Columns("G"), Columns("H"))
'Check whole Workbook, union G and H for values less than rMargin
NextSheet:
Next
End Sub
Thank you

Answer 1

This should work for your needs. Before I get into my code, I just want to note that usually the response you'll get from the community when asking a 'how do I do this' question is that SO is not a code for me site. We are happy to help fix broken code, but these kinds of problems can generally be solved with Google.
That being said, I wanted a break from the project I was working on, so I threw this together. My hope here is that you can use it as a learning opportunity of how to write better code (and maybe get some kudos from your boss in the process).
Here's the code:
Private Sub FindAndCreateSheet3dBm()
' Ideally, you wouldnt even use something like this. For your purposes
' it will get you going. I highly recommend finding a dynamic way of
' determining the positions of the data. It may be consistent now, but
' in the world of programming, everything changes, especially when
' you think it wont.
Const FIRST_INPUT_COL As Long = 3 ' Column C
Const SECOND_INPUT_COL As Long = 4 ' D
Const THIRD_INPUT_COL As Long = 2 ' B
Const FIRST_OUTPUT_COL As Long = 7 ' G
Const SECOND_OUTPUT_COL As Long = 8 ' H
Dim marginReport As Worksheet
Set marginReport = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1))
marginReport.Name = "Less than 3dBm"
Dim targetWorksheet As Worksheet
For Each targetWorksheet In ThisWorkbook.Worksheets
If Not targetWorksheet Is marginReport Then
Dim inputData As Variant
inputData = targetWorksheet.UsedRange.value
Dim outputData As Variant
' I resize the array to be the exact same as the first, but to add two additional columns
ReDim outputData(LBound(inputData, 1) To UBound(inputData, 1), LBound(inputData, 2) To UBound(inputData, 2) + 2)
Dim i As Long
Dim j As Long
' Loop through rows
For i = LBound(inputData, 1) To UBound(inputData, 1)
' Loop through columns
For j = LBound(inputData, 2) To UBound(inputData, 2)
' Essentially, just copy the data
outputData(i, j) = inputData(i, j)
Next
Next
Dim offSetValue As Long
If LBound(outputData, 2) = 1 Then offSetValue = -1
' For your purposes I will use hardcoded indices here, but it is far more ideal to manage this in a more flexible manner
For i = LBound(outputData, 1) To UBound(outputData, 1)
outputData(i, FIRST_OUTPUT_COL) = outputData(i, FIRST_INPUT_COL) - outputData(i, SECOND_INPUT_COL)
outputData(i, SECOND_OUTPUT_COL) = outputData(i, FIRST_OUTPUT_COL) - outputData(i, THIRD_INPUT_COL)
If LessThanMargin(outputData(i, SECOND_OUTPUT_COL)) Then
For j = LBound(outputData, 2) To UBound(outputData, 2)
' I start with the output worksheet, and use the 'End(xlUp) to find the first
' non-blank row. I then iterate columnwise and add values to the row beneath it.
' The offSetValue variable ensures I am not skipping any cells if the array
' is 1-Based versus the default 0-Base.
marginReport.Range("A1048576").End(xlUp).Offset(1, j + offSetValue).value = outputData(i, j)
Next
End If
Next
OutputArray outputData, targetWorksheet, "UpdatedData_" & UCase(Replace(targetWorksheet.Name, " ", "_"))
End If
Next
End Sub
' I am just checking for a negative number here, but change this to use the logic you need
Public Function LessThanMargin(ByVal InputValue As Double)
LessThanMargin = InputValue < 0
End Function
Public Sub OutputArray(ByVal InputArray As Variant, ByVal InputWorksheet As Worksheet, ByVal TableName As String)
Dim AddLengthH As Long
Dim AddLengthW As Long
If NumberOfArrayDimensions(InputArray) = 2 Then
If LBound(InputArray, 1) = 0 Then AddLengthH = 1
If LBound(InputArray, 2) = 0 Then AddLengthW = 1
Dim r As Range
If Not InputWorksheet Is Nothing Then
With InputWorksheet
.Cells.Clear
Set r = .Range("A1").Resize(UBound(InputArray, 1) + AddLengthH, UBound(InputArray, 2) + AddLengthW)
r.value = InputArray
.ListObjects.Add(xlSrcRange, r, , xlYes).Name = TableName
With .ListObjects(1).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End If
End If
End Sub
I use arrays to solve the problem since they are far more efficient when processing data versus using excel-formulas. While this is unlikely to make a performance boost on a ~200 row project, it makes tremendous differences when you're dealing with a few thousand rows or even more.
I also used constants for the column positions to make it easier for you to adjust these in the future. This comes with a caution though, even constants (for this purpose) are terrible habit so dont get used to them. Learn how to calculate where the data is.
Finally, please (for the love of all that is programmatic) don't just copy and paste this code and never look back. I put this up here for you (and others) to learn from it. Not for it to be some sort of quick fix. I hope you can use it to grow.