Lookup and Copy

Not sure I understand your question - however i am using a formula to caculate 100% " =COUNTIF(D5:W104, 100%)" and it is able to determain what cells do and do not have 100% also using conditional formating to color the cell green if it value is 100%...does that help?

Use this code and you will be able to do what you are looking for, I have assumed that your value in A Column will be always be filled in case if that's not then tell me  acolumn which is always filled and will do the necessary changes in the code.

Saurabh...

Sub movedata()
    Dim rng As Range, cell As Range
    Dim r As Range
 
    Set rng = Sheets("Sheet1").Range("A1:A104")
 
    For Each cell In rng
        Set r = Range("D" & cell.Row & ":W" & cell.Row)
 
        If Application.WorksheetFunction.CountIf(r, 100) > 0 Then
            cell.EntireRow.Copy Sheets("Sheet2").Range("A" & Sheets("Sheet2").Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1)
        End If
    Next cell
 
 
End Sub
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

I see where i messed up i am so sorry to be wasting your time by not being clearer! Below is what i should have said, it became clear when the if condition was never met, sorry bout that!


Not sure I understand your question - however i am using a formula to caculate 100%"=IF(F6/16= 0%, "",F6/25)" . " =COUNTIF(D5:W104, 100%)" is able to determain what cells do and do not have 100% also using conditional formating to color the cell green if it value is 100%...does that help?

If you want to move the cells where condition is not meet that is no cell equal to 100% then use this formula...

Saurabh...

Sub movedata()
    Dim rng As Range, cell As Range
    Dim r As Range
 
    Set rng = Sheets("Sheet1").Range("A1:A104")
 
    For Each cell In rng
        Set r = Range("D" & cell.Row & ":W" & cell.Row)
 
        If Application.WorksheetFunction.CountIf(r, 100) = 0 Then
            cell.EntireRow.Copy Sheets("Sheet2").Range("A" & Sheets("Sheet2").Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1)
        End If
    Next cell
 
 
End Sub

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

I created a module and pasted the code: It copied all cells and moved them to the sheet2 essentially copying the whole sheet.

What am i doing wrong?

How would i change the if statment to check the value of the cell?

Found this code modified it working as desired thank's to saurabh726 for all her help and attempts.

Sub SearchForString()

    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer

    On Error GoTo Err_Execute

    'Start search in row 2
    LSearchRow = 2

    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 2

    While Len(Range("A" & CStr(LSearchRow)).Value) > 0

        'If value in column E = "Mail Box", copy entire row to Sheet2
        If Range("G" & CStr(LSearchRow)).Value = 1 Or Range("K" & CStr(LSearchRow)).Value = 1 Or Range("N" & CStr(LSearchRow)).Value = 1 Or Range("Q" & CStr(LSearchRow)).Value = 1 Or Range("T" & CStr(LSearchRow)).Value = 1 Then
                       
            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy

            'Paste row into Sheet2 in next row
            Sheets("Sheet2").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste

            'Move counter to next row
            LCopyToRow = LCopyToRow + 1

            'Go back to Sheet1 to continue searching
            Sheets("Sheet1").Select
           

        End If
           

        LSearchRow = LSearchRow + 1

    Wend

    'Position on cell A3
    Application.CutCopyMode = False
    Range("A2").Select

    MsgBox "All matching data has been copied."

    Exit Sub

Err_Execute:
    MsgBox "An error occurred."

End Sub

I was in a meeting that why i wasnt able to reply you back, however the code which you have is not the optmised one and it can be reduced further, if you can help me with sample data, i can provide you a optimise version of code.

Saurabh...

File saved as 97-2003 should be xlsm