Would like to understand some excel vba code

phoffric
phoffric used Ask the Experts™
on
The code is taken from this post.
https://www.experts-exchange.com/questions/29065786/Spreadsheet-smart-automated-copying-from-one-sheet-to-another.html#a42351651

Option Explicit

Sub CompareInterpolation()
    Dim wsOriginal As Worksheet, wsInterpol As Worksheet
    Dim rwOriginal As Long, rwOriginalMax As Long
    Dim rwInterpol As Long, rwInterpolMax As Long
    Dim arOriginal() As Variant, arInterpolData() As Variant, arInterpolResult() As Variant
    Const Limit As Single = 0.02
    
    Set wsOriginal = Worksheets("Original Data")
    Set wsInterpol = Worksheets("Intepolation")
    rwOriginalMax = wsOriginal.Range("A1").CurrentRegion.Rows.Count
    rwInterpolMax = wsInterpol.Range("A1").CurrentRegion.Rows.Count
    arOriginal = wsOriginal.Range("A1:E" & rwOriginalMax)
    arInterpolData = wsInterpol.Range("A1:B" & rwInterpolMax)
    wsInterpol.Range("K2:O" & rwInterpolMax).ClearContents
    arInterpolResult = wsInterpol.Range("K1:O" & rwInterpolMax)
    
    For rwInterpol = 2 To rwInterpolMax
        For rwOriginal = 2 To rwOriginalMax
            If Abs(Round(arInterpolData(rwInterpol, 1), 3) - arOriginal(rwOriginal, 1)) <= Limit _
             And Abs(Round(arInterpolData(rwInterpol, 2), 3) - arOriginal(rwOriginal, 2)) <= Limit Then
                arInterpolResult(rwInterpol, 1) = arOriginal(rwOriginal, 1)
                arInterpolResult(rwInterpol, 2) = arOriginal(rwOriginal, 2)
                arInterpolResult(rwInterpol, 3) = arOriginal(rwOriginal, 3)
                arInterpolResult(rwInterpol, 5) = arOriginal(rwOriginal, 5)
                Exit For
            End If
        Next rwOriginal
    Next rwInterpol
    wsInterpol.Range("K1:O" & rwInterpolMax) = arInterpolResult
End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Bill PrewIT / Software Engineering Consultant
Top Expert 2016
Commented:
There are two worksheets involve, "Original Data" which is looked at, and the "Intepolation" where new data is placed as this proceddure runs.

The procedure cycles through each row in the the "Intepolation" sheet, and checks columns A and B against all rows of the "Original Data" sheet, columns A and B.  

The first row where the two values are within .02 of each other are saved for that row, and after all analysis is done columns K, L, M and O are updated on the "Intepolation" sheet with the matching columns from "Original Data" sheet.


»bp
IT System Administrator
Distinguished Expert 2017
Commented:
I have added some comments to the code that you posted based on what I see happening in the code. It would be easier to tell exactly what is happening in I had a spreadsheet to test it against.
Option Explicit

Sub CompareInterpolation()
    Dim wsOriginal As Worksheet, wsInterpol As Worksheet    'Worksheets
    Dim rwOriginal As Long, rwOriginalMax As Long           'variables to hold numbers
    Dim rwInterpol As Long, rwInterpolMax As Long           'variables to hold numbers
    Dim arOriginal() As Variant, arInterpolData() As Variant, arInterpolResult() As Variant     'array variables that can hold any type of data
    Const Limit As Single = 0.02
    'setting each of the worksheet variables to a specific worksheet in the active workbook
    Set wsOriginal = Worksheets("Original Data")
    Set wsInterpol = Worksheets("Intepolation")     'This worksheet name might be misspelled
    'These are taking a count of how many rows are contained in the sheet that are bounded by any combination of blank rows or columns
    'A better way would be to use wsOriginal.Range("A" & Rows.count).End(xlUp).row This will give you the last used row even if there are blank rows in your data
    rwOriginalMax = wsOriginal.Range("A1").CurrentRegion.Rows.Count
    rwInterpolMax = wsInterpol.Range("A1").CurrentRegion.Rows.Count
    'These are selecting data from A1 to E and going to the last row before the first blank row
    arOriginal = wsOriginal.Range("A1:E" & rwOriginalMax)
    arInterpolData = wsInterpol.Range("A1:B" & rwInterpolMax)
    'This is clearing any content from range K2 through O and the last row before any blank row
    wsInterpol.Range("K2:O" & rwInterpolMax).ClearContents
    'This is collecting all the rows that were just cleared plus row 1 at the top
    arInterpolResult = wsInterpol.Range("K1:O" & rwInterpolMax)
    'beginning at 2 and going to the last row number before the first blank row on the Interpolation sheet
    For rwInterpol = 2 To rwInterpolMax
    'beginning at 2 and going to the last row number before the first blank row on the Original sheet
        For rwOriginal = 2 To rwOriginalMax
            'comparing the absolute value of, the numbers on the Interpolation sheet rounded to 3 decimals - the numbers on the Original sheet
            'to see if the result is less than or equal to .02 in columns 1 and 2 in the array made from the ranges of collected data
            If Abs(Round(arInterpolData(rwInterpol, 1), 3) - arOriginal(rwOriginal, 1)) <= Limit _
             And Abs(Round(arInterpolData(rwInterpol, 2), 3) - arOriginal(rwOriginal, 2)) <= Limit Then
             'If they are then updating the 1,2,3,5 columns of the Interpolation array to match the Original array
                arInterpolResult(rwInterpol, 1) = arOriginal(rwOriginal, 1)
                arInterpolResult(rwInterpol, 2) = arOriginal(rwOriginal, 2)
                arInterpolResult(rwInterpol, 3) = arOriginal(rwOriginal, 3)
                arInterpolResult(rwInterpol, 5) = arOriginal(rwOriginal, 5)
                Exit For
            End If
        Next rwOriginal
    Next rwInterpol
    'Putting the results left in the Interpolation array into the range K1 through O and the last row before any blank row
    wsInterpol.Range("K1:O" & rwInterpolMax) = arInterpolResult
End Sub

Open in new window

Author

Commented:
Bill's post provides a nice overview for the PAQ of the implicit requirements that I was handling in a manual tedious manner.

Mike's comment is what I was looking for to get a better idea of how I might need to modify the script as I add new features to my spreadsheet. I have incorporated your comments into the spreadsheet.

Thank you for your explanations.

Thanks and Regards,
Paul
Mike in ITIT System Administrator
Distinguished Expert 2017

Commented:
You are welcome. Glad that I could help.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial