Macro in VBA for excel that processes large quantities of data

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.