CODEWITHSUNDEEP
excelvba
Toms Bušmanis
Toms Bušmanis

Reputation: 3

For Next loop - copy cells based on value to another sheet and stack them at the end of table

I am trying to copy values from one sheet to another that have a specific value given based on a formula. Each month there are new entries added and then they are compared to the already existing list. If the formula returns "NEW", then this entry should be added to the list.

I have figured out how to find those entries and copy them, but I have made the code so that it does not add entries, but rather copies them oever eachother in the same cell.

Here is what I got:

Sub CopyX()
    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim SrchRng1 As range
    Dim cel As range
        LastRow1 = Sheets("RAW INPUT").Cells(Rows.Count, 11).End(xlUp).Row
        LastRow2 = Sheets("CALC_corrected").Cells(Rows.Count, 2).End(xlUp).Row
        Set SrchRng1 = Sheets("RAW INPUT").range("L8:L" & LastRow1)
            For Each cel In SrchRng1
                If cel = "NEW" Then
                    cel.Offset(0, -1).Copy
                    Sheets("CALC_corrected").Cells(LastRow2, 3).Offset(1, 0).PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                End If
            Next cel
End Sub

This is where my current knowledge stops. I would really appreaciate if someone could point out what I am missing.

Tom

Upvotes: 0

Views: 34

Answers (2)

Plutian
Plutian

Reputation: 2309

The issue is that if you calculate the last row outside of your loop, but use it inside of your loop (multiple times) it won't get updated, and the row pasted at will stay the same. Try this instead:

Sub CopyX()
    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim SrchRng1 As range
    Dim cel As range
        LastRow1 = Sheets("RAW INPUT").Cells(Rows.Count, 11).End(xlUp).Row

        Set SrchRng1 = Sheets("RAW INPUT").range("L8:L" & LastRow1)
            For Each cel In SrchRng1
                If cel = "NEW" Then
                    cel.Offset(0, -1).Copy
                    LastRow2 = Sheets("CALC_corrected").Cells(Rows.Count, 2).End(xlUp).Row
                    Sheets("CALC_corrected").Cells(LastRow2, 3).Offset(1, 0).PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                End If
            Next cel
End Sub

This way the last row will get updated every time the loop runs, and it will be 1 row higher.

Upvotes: 1

Warcupine
Warcupine

Reputation: 4640

You need to increment lastrow2 it isn't changing as you get more "NEW" cells.

               If cel = "NEW" Then
                    cel.Offset(0, -1).Copy
                    Sheets("CALC_corrected").Cells(LastRow2, 3).Offset(1, 0).PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    LastRow2 = LastRow2 + 1
                End If

Upvotes: 1

Related Questions