Getting extra blank row when looping

Question

This is my first time working with VBA, so hopefully this is something easy. I have code that loops through lines on one workbook, copies certain cells, and appends them into a second workbook. It keeps leaving an extra blank line at the end of the pasted data. I assume it has something to do with my for loop, but I have not found anything online that describes this problem.

i = 5
For Each agentRow In Range("A4:A45")
Workbooks("Agent.xlsx").Activate
    'Check to see if the agent is active this month
    If Range("D" & i).Value > 10 And Range("E" & i).Value > 10 Then
        'If so, copy this data
        Range("A" & i & ", D" & i & ":R" & i & ", U" & i & ":Z" & i).Select
        Selection.Copy

        'Goto the workbook that will store the data
        Workbooks("Agent Stats Monthly.xlsm").Activate
    
        'Find the last row with data, then paste onto the next row
        findLastRow = 1 + Range("A:A").SpecialCells(xlCellTypeLastCell).Row

        Range("A" & findLastRow).PasteSpecial
    End If
i = i + 1
Next agentRow

How do you identify this *"extra blank line"* when all the rows below are empty? Maybe your preceding code already references the first empty row and you add some formatting to it (e.g. highlight it), making it the last row of the used range so it is actually the first row that causes this behavior? — VBasic2008, Dec 22 '22 at 23:43
Is this code in the `Agent Stats Monthly.xlsm` workbook? What is the (tab) name of the worksheet in it? What is the (tab) name of the worksheet in the `Agent.xlsx` workbook? What is the value of `i` and how do you obtain it, before entering the loop? — VBasic2008, Dec 23 '22 at 00:12
I edited the post and added the i value. The code is run from the agent stats monthly workbook and there is only one tab there for now. I had not thought of defining it, but I will be adding more tabs so I should define that. — Iakona, Dec 23 '22 at 14:22
The rows fill with data AND the borders. The last line is beyond the rows with data but it has the borders, so it's copying and pasting a line that does not meet the if statement requirements. — Iakona, Dec 23 '22 at 14:24

Notus_Panda · Answer 1 · 2022-12-23T08:57:58.920

A few things to note:

If you use .Offset(row,col) , you don't need to use i in your For each loop (albeit more useful to just use a normal for loop
Your lastrow is probably better obtained by

Workbooks("Agent Stats Monthly.xlsm").Sheets("YourSheetWithData").Range("A" & Rows.Count).End(xlUp).Row

You shouldn't use Select to copy/paste: see: Avoid Select in VBA
You don't need to use copy/paste in your example, you can just set the values
You don't need to activate a workbook to change values in its sheets
PasteSpecial as what? Usually used to get rid of formulas with PasteSpecial xlPasteValues

I know those are a lot of "negatives" but this is meant as helpful criticism. You're doing far better than when I started with vba :)

The reason why you're getting an extra empty row is likely due to the starting value of your i

Workbooks("Agent.xlsx").Activate
Dim wbS As Workbook: Set wbS = Workbooks("Agent Stats Monthly.xlsm")
Dim wsS As Worksheet: Set wsS = wbS.Sheets("YourDataSheet")
Dim lRowS As Long
lRowS = wsS.Range("A" & Rows.Count).End(xlUp).Row
For Each agentRow In Range("A4:A45")
    i = agentRow.Row 'I'm assuming that agentRow is a Range object since it's in Range("A4:A45")
    'Check to see if the agent is active this month
    If Range("D" & i).Value > 10 And Range("E" & i).Value > 10 Then
        'If so, copy this data
        lRowS = lRowS+1 'only add +1 if you're going to add a row to your DataSheet
        Dim colCount As Long: colCount = 0
        Dim areaR
        For Each areaR In Range("A" & i & ", D" & i & ":R" & i & ", U" & i & ":Z" & i).Areas
            colCount = colCount + areaR.Columns.Count
        Next areaR
        wsS.Range("A" & lRowS).Resize(1,colCount).Value = Range("A" & i & ", D" & i & ":R" & i & ", U" & i & ":Z" & i).Value
    End If
Next agentRow

Hope I didn't forget anything and used the resizing correctly, I'm still learning myself and unable to test right now.. If anything is unclear, feel free to ask, I'll answer in the morning.

**EDIT: ** Just noticed I did the resizing wrong when reading VBasic's answer, didn't noticed it was a continued range D:R, etc. My apologies. I adjusted my code but it's seeming less elegant now compared to VBasic's code. I do hope however that you can learn from both our code as is the point of this site.

Please do not apologize for the advice. I really appreciate it. It gives me insight to best practices. I'll comb through this today. THANK YOU! — Iakona, Dec 23 '22 at 14:26

score 2 · Accepted Answer · answered Dec 23 '22 at 01:51

Copy Discontinuous Row Ranges

Sub CopyAgentData()
     
    ' Source
    Dim swb As Workbook: Set swb = Workbooks("Agent.xlsx")
    Dim sws As Worksheet: Set sws = swb.Sheets("Sheet1") ' adjust!
    Dim srg As Range: Set srg = sws.Range("D4:E45") ' read
    Dim scrg As Range: Set scrg = Intersect( _
        srg.Rows(1).EntireRow, sws.Range("A:A,D:R,U:Z")) ' copy (first row)
    
    ' Destination
    Dim dwb As Workbook: Set dwb = Workbooks("Agent Stats Monthly.xlsm")
    ' If this code is in this workbook, instead use:
    'Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Sheets("Sheet1") ' adjust!
    Dim dfCell As Range: Set dfCell = dws.Range("A2")
    Dim dlCell As Range: Set dlCell = dws.UsedRange _
        .Find("*", , xlFormulas, , xlByRows, xlPrevious)
    If Not dlCell Is Nothing Then
        If dfCell.Row <= dlCell.Row Then
            Set dfCell = dws.Cells(dlCell.Row + 1, dfCell.Column)
        End If
    End If
    
    ' Loop.
    
    Dim srrg As Range ' Current Read Row Range

    For Each srrg In srg.Rows
        'Check to see if the agent is active this month
        If srrg.Cells(1).Value > 10 And srrg.Cells(2).Value > 10 Then
            'If so, copy this data
            'Debug.Print srrg.Address, scrg.Address, dfCell.Address
            scrg.Copy dfCell
            Set dfCell = dfCell.Offset(1) ' next first destination cell
        End If
        Set scrg = scrg.Offset(1) ' next source copy row range
    Next srrg

End Sub

This is soooo close. It performed everything just right, but there's still the row at the bottom with no data, but with cell borders. — Iakona, Dec 23 '22 at 14:36
I added a picture to the original post in case that helps explain what I'm seeing. — Iakona, Dec 23 '22 at 14:38
You know, the next time I run it, the code writes over the blank row. Mine was leaving the blank line in each time I ran it. This will work just fine. Thank you! — Iakona, Dec 23 '22 at 14:59
If I understand this correctly, you create an array. Then you do not paste, but "set" the value of the row. The difference being, the row that receives the data is not activated. The part I left out in my example (did not seem relevant at the time) is that I am adding a date to the end of each row. Would best practice be to find the row number receiving the data and place the date in the last cell, to write a separate loop for that, or to append the date into the array as it copies the data from the source? Thank you for your guidance. — Iakona, Dec 23 '22 at 15:35

Getting extra blank row when looping

2 Answers2

Copy Discontinuous Row Ranges