VBA IF then Loop help needed copy value to another sheet

[studentpro]

I am not familiar with VBA if then loops so I don't really know where I would begin to write what I need. here's the scenario:

In sheet (1)
If cell values in column (F) = 1
then, in that same row, copy cell value in column (A)
and find the next empty cell and paste in sheet (2) column(B)

the data I am working could have 100k rows with data in it.

If anyone has any ideas on how to write something like that let me know. I have seen other threads that are kind of similar but they were more focused on extracting the entire row if the criteria was met instead of just one column value.

 

[tygrrboi]

Hows this?

Sub YourMacro()
Dim i as Integer
With Sheets("Sheet1")
    For i = 1 to .Cells(.Rows.Count, "F").End(xlUp).Row[COLOR=#3D3D3D][FONT=&quot]
[/FONT][/COLOR]        If .Range("F" & i).Value = 1 Then
            Sheets("Sheet2").Range("B" & Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "B").End(xlUp).Row + 1).Value = .Range("A" & i).Value
        End If
    Next i
End With
End Sub

 

[Trebor76]

With a dataset that big I would avoid looping but filter the data and then copy only the visible cells like so:

Option Explicit
Sub Macro1()

    'http://www.mrexcel.com/forum/excel-questions/960638-visual-basic-applications-if-then-loop-help-needed-copy-value-another-sheet.html

    Dim lngLastRow   As Long
    Dim rngCopyRange As Range
    
    Application.ScreenUpdating = False
    
    With Sheets("Sheet1")
        'Remove any existing filters
        .AutoFilterMode = False
        'Set the 'rngCopyRange' range variable
        lngLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Set rngCopyRange = Sheets("Sheet1").Range("A2:A" & lngLastRow) 'Assumes the data starts at Row 2.  Change to suit if necessary.
        'Filter the data in Col. F by the value 1
        .Range("F1").AutoFilter Field:=1, Criteria1:=1
         'Copy the filtered data in Col. A to the next available row in Col. B of Sheet2.
        rngCopyRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1)
        'Remove existing filter
        .AutoFilterMode = False 'Comment out this line if you want the filter left in place
    End With
    
    Application.ScreenUpdating = True
    
End Sub

HTH

Robert

 

[studentpro]

Trebor76 I tried your VBA and it errors out stating that no matches were found because the VBA is filtering by column A instead of F. I put in the VBA exactly how you have but that's what keeps happening.

 

[studentpro]

Tygrrboi: your VBA did work, thank you. lets say I needed to copy over not only column (A) value but (B), (C) and (D) as well, how would I add that to your VBA?

 

[Trebor76]

found because the VBA is filtering by column A instead of F

Ah, my bad

See if changing this line of code...

.Range("F1").AutoFilter Field:=[B]1[/B], Criteria1:=1

...to this does the job:

.Range("F1").AutoFilter Field:=[B]6[/B], Criteria1:=1

Robert

 

[tygrrboi]

Tygrrboi: your VBA did work, thank you. lets say I needed to copy over not only column (A) value but (B), (C) and (D) as well, how would I add that to your VBA?

I am glad it worked for you, however I do think that Trebor's code will be faster if you can get it to work for your situation.

anyway. To answer your request:
I will assume you want to copy the values from ABCD of the same row of sheet1 and paste it into BCDE of sheet2 in the same row. Try this.

Sub YourMacro()
Dim i as Integer
With Sheets("Sheet1")
    For i = 1 to .Cells(.Rows.Count, "F").End(xlUp).Row[COLOR=#3D3D3D]
[/COLOR]        If .Range("F" & i).Value = 1 Then
            Sheets("Sheet2").Range("B" & Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "B").End(xlUp).Row + 1).Resize(1,4).Value = .Range("A" & i & ":D" & i).Value
        End If
    Next i
End With
End Sub

 

[Trebor76]

If you were to use tygrrboi's nifty solution I would change the i variable to Long as an Integer limit is 'only' 32,767.