mercredi 20 décembre 2017

Excel VBA - Row by Row Copy with If-Statement Validation

I'm relatively new to VBA and have found myself in a bit of a corner.

The goal: I want to copy row values from one spreadsheet to another only if specific fields match between the two rows. If the specific fields don't match, I need to skip a row on the copied TO workbook and then re-check the copied FROM workbook, creating a gap until they match again.

EX: Let the copied TO workbook = WB_A Let the copied FROM workbook = WB_B

Both workbooks have a column with ID#, X coordinates, and Y coordinates

WB_A has a static set of ID#'s ranging from -99 to 632 with accompanying X&Y coordinates. WB_B has a dynamic set of ID#'s which also fall within the -99 to 632 range but may have gaps in the data (149-161 may be completely missing so that the count goes 147,148,162,163...).

I want to copy values from WB_B to WB_A only if the ID#'s match on the given row, otherwise I want to leave a gap on WB_A until it does match with WB_B.

My Method:

    Private Sub rowCount()

Dim mstRows As Long
Dim wsMstr As Worksheet, wsPline As Worksheet
Dim wbCompRes As Workbook, wbPline As Workbook
Dim i As Integer
Dim rowCounter As Integer



'Find end of Master Worksheet rows

Set wsMstr = ThisWorkbook.Worksheets("Master Wkst")

wsMstr.Activate

mstRows = Worksheets("Master Wkst").Cells(Rows.Count, 1).End(xlUp).Row


'If statment to check if column a1 in Master Wkst = Column b2 in pline file
'If true, copies rows into Master Wkst, If false, skips row

rowCounter = 4

Application.ScreenUpdating = False


For i = 4 To mstRows


    If wsMstr.Cells(i, 1).Value <> Workbooks("20170210_intersect_pline_transect_singlept.dbf") _
    .Worksheets(1).Cells(rowCounter - 2, 2) Then

    rowCounter = 4


    Else

        If wsMstr.Cells(i, 1).Value = Workbooks("20170210_intersect_pline_transect_singlept.dbf") _
        .Worksheets(1).Cells(rowCounter - 2, 2) Then

            Workbooks("20170210_intersect_pline_transect_singlept.dbf").Activate

            Worksheets(1).Range(Cells(rowCounter - 2, 4), Cells(rowCounter, 5)).Copy

            wsMstr.Activate

            wsMstr.Cells(i, 6).Select

            ActiveSheet.Paste

            rowCounter = rowCounter + 1


        End If

    End If


Next

Application.ScreenUpdating = True


End Sub

Currently, I have the code so that it skips the first gap in the data, and then fills out until it gets to the second, gap. My trouble is in cycling through WB_A's non-matching rows while holding WB_B on the same row until it can be matched up with WB_A.

Right now, I have rowCount=4 as a static field, and I know this will be what needs to change, but I am unsure how to change it to make the code function as intended.

I've included links the Pertinent Excel files Note: WB_A = Computation_results2017 WB_B = 20170210_Pline....

Computation_results2017

20170210_Pline...

Additionally, any other tricks which might make my code more succinct are welcome!

Thanks for the help.

Aucun commentaire:

Enregistrer un commentaire