CODEWITHSUNDEEP
vbaexcelloopsrange
Pericles Faliagas
Pericles Faliagas

Reputation: 636

Loop through cells and copy paste values according to if condition

I want to loop through a range of cells and extract specific information. I am trying to copy paste the cell.offset(0,-2) of the cell (a range) in sheet("Tracker") in the next empty cell of column D in sheet("1") if the value of the cell is the same as the variable r.Value (a variable that is an input value that changes everytime, so it has to stay as a variable). SO, since I am having cell (range) you understand its a loop for all the cells in the column G of the sheet("Tracker"). It works so far but the only thing that it does is get the first cell offset and paste it in the cell d1 of the destination sheet, overwritting my header. I want it to paste it from cell D2(first empty cell) and do this for all cells that abide by the if condition. Any ideas? The code is provided below..

The code below is the revised one!

The problem with the dates is as shown above.. I want to be as it appears inside the cell, not on the top of the page.. enter image description here

Dim v As Range
    Set v = Sheets("1").Cells(Worksheets("1").Rows.Count, "D").End(xlUp)
    With Sheets("Tracker")
    For Each cell In .Range(.Cells(2, "G"), .Cells(.Rows.Count, "G").End(xlUp))
    If cell.Value = r.Value Then
    Set v = v.Offset(1, 0)
    v = cell.Offset(0, -2).Value
    End If
    Next cell
    End With

Upvotes: 1

Views: 2955

Answers (1)

user4039065
user4039065

Reputation:

Avoid select; explicitly define the parent worksheet; look from the bottom up to find the last populated cell; define your range with a starting point and an ending point.

Dim v As Range
Set v = WORKSheets("1").Cells(WORKSheets("1").Rows.Count, "D").End(xlUp)
with WORKSheets("Tracker")
    For Each cell In .Range(.cells(2, "G"), .cells(.rows.count, "G").End(xlUp))
        If Int(cell.Value2) = Int(r.Value2) Then
            Set v = v.Offset(1, 0)
            v = cell.Offset(0, -1).value
        end if
    Next cell
end with

Upvotes: 2

Related Questions