Looping through cells within a range

[benoah]

Hello Pros. I have an ongoing project I am working on but am stuck on this step. I have a range of data from "F22 (top left) to dynamic (bottom right)". It finds the range just fine. I need to check each cell in the range to meet a certain criteria. If it meets that criteria I will need to find information based on that cell location within the range. Temporarily, I have created a simple copy and paste command to get me to that next step but I can't get it to copy the data to column A. It keeps copying the value from the cell location it was pasted in, from column A and not from the next cell that matches the criteria within the range. I know the problem is in the ActiveCell.Copy line of code but can't seem to figure it out. Thanks for your help.


Sub asubpayments()


Dim ccol, finalrow, finalcolumn As Integer
Dim rngAll As Range
Dim i As Integer, j As Integer




'set the colorindex of the submitted payments to the ccol variable
ccol = Sheets("Canterfield - Sub Payments").Range("F13").Interior.ColorIndex
'set the last row of data in the range to the final row variable
finalrow = Sheets("Canterfield - Sub Payments").Range("B10000").End(xlUp).Row
'set the last column of data in the range to the final column variable
finalcolumn = Sheets("Canterfield - Sub Payments").Range("DA22").End(xlToLeft).Column


'set the total range to search for criteria
ActiveWorkbook.Sheets(2).Select
Range(Cells(22, 6), Cells(finalrow, finalcolumn)).Select
Set rngAll = Selection

'loop through the range
For i = 1 To rngAll.Rows.Count
For j = 1 To rngAll.Columns.Count
'if then to search for submitted payment colorindex
If rngAll.Cells(i, j).Interior.ColorIndex = ccol Then
ActiveCell.Copy
Range("A10000").End(xlUp).Select
ActiveCell.Offset(1, 0).PasteSpecial xlPasteValues
Else
rngAll.Cells(i, j).Font.ColorIndex = 6
End If
Next j
Next i



End Sub

 

[L. Howard]

Since you have your range, maybe something like this for the loop.

Howard

Dim c as Range

 'loop through the range
 For Each c In rngAll
 
 'if then to search for submitted payment colorindex

 If c.Interior.ColorIndex = ccol Then
    c.Copy
    Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
 
 Else
   c.Font.ColorIndex = 6
 End If
 Next

 

[benoah]

Since you have your range, maybe something like this for the loop.

Howard

Dim c as Range

 'loop through the range
 For Each c In rngAll
 
 'if then to search for submitted payment colorindex

 If c.Interior.ColorIndex = ccol Then
    c.Copy
    Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
 
 Else
   c.Font.ColorIndex = 6
 End If
 Next

Thanks so much Howard. Works perfect! I have so much to learn!

 

[L. Howard]

You're welcome. Glad it is working for you.

And just to add, keep you mind open to using FIND instead of a loop. I wouldn't try to do anything with it here. Just a heads up.

Howard