Need AND in Macro between two IFS

[TJC86]

Please can someone help me to work out how to change this macro so that both statements need to be true, rather than both running but bringing back results of both:

Sub CopyAtt1()


Application.ScreenUpdating = False


Application.StatusBar = "Please be patient..."






Worksheets("Sheet1").rows("25:5000").ClearContents




Dim bottomL As Integer
bottomL = Sheets("DB").Range("A" & rows.Count).End(xlUp).Row

Dim c As Range
For Each c In Sheets("DB").Range("A1:A" & bottomL)
If c.Value = Range("C5") Then
c.EntireRow.Copy Worksheets("Sheet1").Range("A" & rows.Count).End(xlUp).Offset(1)
End If
Next c




Dim d As Range
For Each d In Sheets("DB").Range("D1:D" & bottomL)
If d.Value = Range("E5") Then
d.EntireRow.Copy Worksheets("Sheet1").Range("A" & rows.Count).End(xlUp).Offset(1)
End If
Next d


Application.StatusBar = False

MsgBox "Update is now complete"

End Sub



Thanks.

 

[TJC86]

With that one added, I get "Run time error" - Type Mismatch & when in debug the following is highlighted:
If Rw.Cells(1, 1) = Range("C5") _
And Rw.Cells(1, 4) = Range("E5") _
And Rw.Cells(1, 7) = Range("G5") _
And Rw.Cells(1, 10) = Range("I5") _
And Rw.Cells(1, 11) = Range("K5") Then

The last row I think has the little arrow pointing at it.

Thanks.

 

[Fluff]

Can you post a sample of your data?

 

[Fluff]

Hiya
Thanks for the file, unfortunately as I run 2003, most of your file won't work. That said I'm pretty sure that this should now work.

Sub CopyAtt1()

    Dim Sht1 As Worksheet
    Dim DBSht As Worksheet
    Dim Rw As Variant
    Dim bottomL As Integer
    
Application.ScreenUpdating = False
Application.StatusBar = "Please be patient..."
    
    Set Sht1 = Worksheets("Sheet1")
    Set DBSht = Worksheets("DB")
    
    Sht1.Rows("25:5000").ClearContents
    
    bottomL = DBSht.Range("A" & Rows.Count).End(xlUp).Row
    
    If Sht1.Range("C5,E5,G5,I5,K5").Value = "" Then
        DBSht.Range("A3").CurrentRegion.Offset(2).Copy Sht1.Range("A" & Rows.Count).End(xlUp).Offset(1)
        Exit Sub
    End If
    For Each Rw In DBSht.Range("A3").CurrentRegion.Rows
        If Rw.Cells(1, 1) = Sht1.Range("C5") _
            And Rw.Cells(1, 4) = Sht1.Range("E5") _
            And Rw.Cells(1, 7) = Sht1.Range("G5") _
            And Rw.Cells(1, 10) = Sht1.Range("I5") _
            And Rw.Cells(1, 11) = Sht1.Range("K5") Then
            Rw.Cells(1, 1).EntireRow.Copy Sht1.Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next Rw

Application.StatusBar = False

MsgBox "Update is now complete"

End Sub