if then else statement not working

**cfinch100** · 02-22-2013, 04:22 PM

hi

i have done this statement it copies a range to 3 sheets ,i have put a if then else statement , if yes is on row q3 then only copy rows = to yes
but now the first statement will not work now,could someone give me some guidance please,have read and downloaded lots of samples,just stuck now
cheers colin

Private Sub CommandButton1_Click()
Dim x As Long, NR As Long, CR As Long, SC As Long
    Dim c As Range
For Each c In Worksheets("mfr_list").Range("Q3:Q100")
    If c.Value = "Yes" Then
    
NR = 46
CR = 3
SC = 3
  For x = 3 To Sheets("MFR_List").UsedRange.Rows.Count
 If Application.CountBlank(Range(Cells(x, 1), Cells(x, 6))) = 0 Then
 Range(Cells(x, 1), Cells(x, 6)).Copy Sheets("Completed").Cells(CR, "A")
 Range(Cells(x, 1), Cells(x, 6)).Copy Sheets("invoice").Cells(NR, "A")
 Range(Cells(x, 1), Cells(x, 6)).Copy Sheets("stored contracts").Cells(SC, "A")
 Range(Cells(x, 1), Cells(x, 6)).Copy Sheets("Completed").Cells(CR, "A")
NR = NR + 1
CR = CR + 1
SC = SC + 1


Else: MsgBox "no copy"
 

 End If
 
 Next x
 End If
 Next c
 End Sub

**HaHoBe** · 02-22-2013, 04:36 PM

Hi, colin,

maybe just set a With-Statement with the sheet name and refer to that? If nothing is indicated ranges refer to the active sheet.

Private Sub CommandButton1_Click()
Dim x As Long, NR As Long, CR As Long, SC As Long
Dim c As Range
With Sheets("mfr_list")
  For Each c In .Range("Q3:Q100")
    If c.Value = "Yes" Then
      NR = 46
      CR = 3
      SC = 3
      For x = 3 To .UsedRange.Rows.Count
        If Application.CountBlank(.Range(.Cells(x, 1), .Cells(x, 6))) = 0 Then
          .Range(.Cells(x, 1), .Cells(x, 6)).Copy Sheets("Completed").Cells(CR, "A")
          .Range(.Cells(x, 1), .Cells(x, 6)).Copy Sheets("invoice").Cells(NR, "A")
          .Range(.Cells(x, 1), .Cells(x, 6)).Copy Sheets("stored contracts").Cells(SC, "A")
          .Range(.Cells(x, 1), .Cells(x, 6)).Copy Sheets("Completed").Cells(CR, "A")
          NR = NR + 1
          CR = CR + 1
          SC = SC + 1
        Else
          MsgBox "no copy"
        End If
      Next x
    End If
  Next c
End With
End Sub

Why not apply an Autofilter to narrow down the number of cells to be checked?

Ciao,
Holger

**cfinch100** · 02-22-2013, 04:51 PM

hi
thanks for the code but it did not do anything im afraid, have you any other ideas please
cheers colin

**cfinch100** · 02-22-2013, 05:19 PM

hi
have just found this code works well, just screen flickers alot is there any way to stop this
cheers colin

Dim r As Long, endRow As Long, pasteRowIndex As Long

endRow = 100 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1

For r = 1 To endRow 'Loop through sheet1 and search for your criteria

    If Cells(r, Columns("q").Column).Value = "yes" Then 'Found

            'Copy the current row
            Rows(r).Select
            Selection.Copy

            'Switch to the sheet where you want to paste it & paste
            Sheets("completed").Select
            Rows(pasteRowIndex).Select
            ActiveSheet.Paste

            'Next time you find a match, it will be pasted in a new row
            pasteRowIndex = pasteRowIndex + 1


           'Switch back to your table & continue to search for your criteria
            Sheets("mfr_list").Select
    End If
Next r
End Sub