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.

 

[Fluff]

Hiya
This should do what you want

Sub CopyAtt1()

Application.ScreenUpdating = False

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


Worksheets("Sheet2").Rows("25:5000").ClearContents

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


For Each Rw In Sheets("DB").Range("A1").CurrentRegion.Rows
    If Rw.Cells(1, 1) = Range("C5") And Rw.Cells(1, 4) = Range("E5") Then
        Rw.Cells(1, 1).EntireRow.Copy Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
Next Rw


Application.StatusBar = False

MsgBox "Update is now complete"

End Sub

 

[TJC86]

Hi, thanks for the reply. I can't seem to get that to bring back any values at all.

Basically what I want is, I have 5 drop down boxes at the top of the page and I want to check the values in these against a DB (sheet called "DB") so if all the values match a row in the DB then copy that whole row and paste into Sheet1. Also, if the drop down boxes are blank, to bring back everything (all results).

I'm slowly losing the will to live on this, I'm very new to VBA and clearly I have no natural talent for it, haha.

Any help much appreciated.

 

[Fluff]

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:

This along with the title & your code is 2 values not 5 & also no mention of drop down boxes!
Whilst I've never used drop down boxes on a sheet, I'll see if i can help, but I need to know what cells the boxes are in.

 

[TJC86]

Hi again,

Yeah well I was starting with two because I thought I could then work through to add the extra 3!

The drop down boxes link to the cell behind, so it is just a cell value effectively. They are in cells C5, E5, G5, I5 and k5.

Thank you. Your help is very much appreciated!

 

[Fluff]

Forgot to mention something.
in your code column A refers to C5 & column D refers to E5, what columns do the other 3 cells refer to?

 

[TJC86]

G5 = Col G
I5 = Col J
K5 = Col K


Thanks.

 

[Fluff]

OK
Have a go with this

Sub CopyAtt1()


Application.ScreenUpdating = False


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

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


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

If Sheets("DB").Range("C5,E5,G5,I5,K5").Value = "" Then
    Range("A1").CurrentRegion.Copy Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Exit Sub
End If

For Each Rw In Sheets("DB").Range("A1").CurrentRegion.Rows
    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
        Rw.Cells(1, 1).EntireRow.Copy Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
Next Rw

Application.StatusBar = False

MsgBox "Update is now complete"

End Sub

 

[TJC86]

HI,

Thanks again for your effort.

This seems to just copy the top 24/25 rows in "Sheet 1" and pastes them below, and nothing from the "DB" tab.

Kind regards,

 

[Fluff]

Add the line in red as shown below

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

[COLOR=#ff0000]Sheets("DB").Activate[/COLOR]