CODEWITHSUNDEEP
vbaloopsif-statement
user2981080
user2981080

Reputation: 29

VBA Looping through an IF Statement

Kind of new to VBA programming but need it to complete a project.

I'm basically trying to copy and paste cells based on an IF Statement and would like to do this on a cell-by-cell basis so I incorporated a loop. The code looks like the following below. What ends up happening is that the first line is copied/pasted just fine but the loop does not continue. When I use debug.print i , the only number that is populated is 6. I've also tried a For Statement but that ends up behaving the same way. Any ideas?

Private sub Copy_Dates()
Dim i as Integer
i =6 

Do 
   If Cells(i,79)= 1 then 
       Sheets("Tracking").Select
       Range(Cells(i,106),Cells(i,108)).Copy

       Sheets("Tr_Tracking").Select
       Range(Cells(i_25003,2),cells(i+25003,4)).PasteSpecial Paste:=xlPasteValues
   End if 
i= i+1
Loop while i < 10

End sub

EDIT: So I've realized that the code that i wanted is not going to be very helpful to my project anymore. What I really need is a method to select non consecutive cells based on a criteria, and then copy those cells to another worksheet as a single block.

So, taking from the above code, I need to make sure to select 

.range(.cells(i,106,.cells(i,108))

only when the following condition is met:

if .cells(i,79)=1

then imagine that i would have some array of selected cells based on this condition and then i would be able to paste it to the second sheet defined above wsO=thisworkbook.sheets("TR_Tracking").

I hope that makes sense and hopefully not too complicated of logic.

EDIT:EDIT: I was able to figure this one out. I used the following code below to accomplish the edit section above. 

Private Sub SelectArray_andCopy()
Dim FinalSelection as Range
Sheets("Tracking").Select
Cells(2,79).Select
For each c in intersect(activesheet.usedrange,range("CA6:CA500"))
    if c.value=1 then 
        if finalselection is nothing then   
            set finalselection=range(cells(c.row,106),cells(c.row,108))
        else
            set finalselection = union(finalselection, range(cells(c.row,106,cells(c.row,108)))
        end if 
    end if 
next c 
if not finalselection is nothing then finalselection.select

Selection.copy
Sheets("TR_Tracking").Select
Range("b250009,d26000").PasteSpecial Paste:=xlPasteValues

Upvotes: 1

Views: 2632

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149287

The problem is that you are using .Select and hence the focus is changing. Also your cells objects are not fully qualified.

INTERESTING READ

Further i_25003 is incorrect. I guess you meant i + 25003

Try this (UNTESTED)

Private Sub Copy_Dates()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim i As Long

    Set wsI = ThisWorkbook.Sheets("Tracking")
    Set wsO = ThisWorkbook.Sheets("Tr_Tracking")

    For i = 6 To 9
        With wsI
            If .Cells(i, 79) = 1 Then
               wsO.Range(wsO.Cells(i + 25003, 2), wsO.Cells(i + 25003, 4)).Value = _
               .Range(.Cells(i, 106), .Cells(i, 108)).Value
            End If
        End With
    Next i
End Sub

Upvotes: 2

Related Questions