Trying to copy specific columns in a row to another excel sheet based on it meeting certain criteria

Question

Im very new to excel/vba and trying to use a macro to check a column for the value true, when it sees that value I'd like it to copy parts of that row to another sheet in my column. Then I need it to iterate through the other rows and perform the same checks. Here is my code currently.

Sub Macro3()
'
' Macro3 Macro
'

'
Sheets("Aspen Data").Select
Dim tfCol As Range, Cell As Object


Set tfCol = Range("G26:G56")

Sheets("Code").Select
ActiveSheet.Calculate
Sheets("Aspen Data").Select
ActiveSheet.Calculate

For Each Cell In tfCol

    If IsEmpty(Cell) Then
        Exit Sub
    End If

    If Cell.Value = "True" Then

Range("I26:Q26").Select
Selection.Copy
Sheets("AspenHist").Select
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    End If

    Next


End Sub

The issue appears to be in getting my Range("I26:Q26) to increment by one as it goes through the loop.

`getting my Range("I26:Q26) to increment` It won't increment if you hard code it. Also, consider `findnext` Edit: nevermind the `findnext`, you're only going from row 26 to 56. Looping rows isn't detrimental to performance here. — findwindow, Apr 27 '16 at 15:17
Do you have a recommendation for how to declare my range variable and increment it instead of the way its written? i was really hoping just running through the for each loop would natively increment it. — Tyler Cohen, Apr 27 '16 at 15:22
`hoping just running through the for each loop would natively increment it` computers do _exactly_ what you tell them to do. So if you ordered `Range("I26:Q26").Select` how can you expect the machine to know you want to move to row 27 next time??? As for recommendation, look up a `for i=1 to x` loop. Edit: a link [here](https://msdn.microsoft.com/en-us/library/5z06z1kb.aspx). — findwindow, Apr 27 '16 at 15:24
Thank you both of you for the resources this is what I need to do. — Tyler Cohen, Apr 27 '16 at 15:38

score 0 · Accepted Answer · answered Apr 27 '16 at 15:32

0

Try this

Sheets("Aspen Data").Select
Dim i As Integer

Sheets("Code").Calculate
Sheets("Aspen Data").Calculate

For i = 26 To 56

If IsEmpty(Cells(i, 7)) Then
    Exit Sub
ElseIf Cells(i, 7).Value = "True" Then

Range(Cells(i, 9), Cells(i, 12)).Copy
Sheets("AspenHist").Activate
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Aspen Data").Activate
End If

Next i

answered Apr 27 '16 at 15:32

Tim Wilkinson

3,761
11
34
62

Yes! thats perfect, I just need to copy some extra rows so ill expand from i,9/ i,12 to i,17. Thank you! – Tyler Cohen Apr 27 '16 at 15:39
1

While this does address the issue at hand, it would help if you don't perpetuate the use of `select` and `copy/paste` for values :/ – findwindow Apr 27 '16 at 15:40
@TylerCohen if you need to copy more rows change the 56 in `i = 26 To 56' to a higher number. Only change `Cells(i, 12)` if you want to copy more columns. Also take note of findwindows comment, and try to amend. – Tim Wilkinson Apr 28 '16 at 10:05

score 0 · Answer 2 · edited May 23 '17 at 12:31

There's no need to use .Select/.Activate/ActiveSheet (see this) to accomplish your goals, and you can definitely use For Each. Try this:

Option Explicit

Sub Macro1()
    '
    ' Macro1 Macro
    '

    '
    Dim tfCol As Range, Cell As Object

    Set tfCol = Sheets("Aspen Data").Range("G26:G56")

    Application.ScreenUpdating = False

    Sheets("Code").Calculate
    Sheets("Aspen Data").Calculate

    For Each Cell In tfCol

        If IsEmpty(Cell) Then
            Exit For
        End If

        If Cell.Value = "True" Then

            Sheets("Aspen Data").Range("I" & Cell.Row & ":Q" & Cell.Row).Copy
            Sheets("AspenHist").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _
                Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If

    Next

    Application.ScreenUpdating = True

End Sub

Trying to copy specific columns in a row to another excel sheet based on it meeting certain criteria

2 Answers2