Solved: VBA - Value Copy Multiple Criteria

[dakkat]

Hello,
I have having difficulties creating a script that contains multiple Criteria. I have the code working with 1 If statement, but after adding a second, it runs but does not copy and paste any results.

I am matching on the datasheet, a Name (A Column) to the users tab Name (D3), and then based upon a match if the result on the datasheet (C Column) = "SHIFT" AND (E Column) = "YES" then copy the value in Column C).

Sub SHIFT()

Dim r As Range, cell As Range, sh As Worksheet
Dim lastrow As Long, c As Range, fDate As Date
With Worksheets("exc")
Set r = .Range(.Range("A7"), .Range("A7").End(xlDown))
End With
For Each cell In r
For Each sh In Worksheets
If LCase(sh.Name) <> "exc" Then
If sh.Cells(3, "D").Value = cell Then
If cell.Offset(0, 2).Value = "SHIFT" & cell.Offset(0, 4).Value = "YES" Then
cell.Offset(0, 3).Copy
fDate = cell.Offset(0, 1).Value
Set c = sh.Range("A46:A76").Find(fDate, LookIn:=xlValues)
If Not c Is Nothing Then
sh.Range("AD" & c.Row).PasteSpecial xlPasteValues
Else
End If
End If
End If
End If
Next
Next

End Sub


I can get it to work without the date search if I wanted to copy the value into a fixed cell. I can get it to work with a date match but with only one criteria. However, adding the secondary match criteria the code runs but does not copy anything.

The code below is another script that works fine, with copying a value after matching a date range with a single criteria. All I need to do is add a second criteria and cannot seem to make it work. Might be easier to say what I would need to do with the code below to add a second criteria and then I can just change the specifics to match the fields and columns.

Dim r As Range, cell As Range, sh As Worksheet
Dim lastrow As Long, c As Range, fDate As Date
With Worksheets("anew")
Set r = .Range(.Range("A7"), .Range("A7").End(xlDown))
End With
For Each cell In r
For Each sh In Worksheets
If LCase(sh.Name) <> "anew" Then
If sh.Cells(3, "D").Value = cell Then
If cell.Offset(0, 1).Value = "YES" Then
fDate = cell.Offset(0, 4).Value
Set c = sh.Range("A46:A76").Find(fDate, LookIn:=xlValues)
sh.Range("U" & c.Row) = cell.Offset(0, 8).Value / 100
sh.Range("AE" & c.Row) = cell.Offset(0, 6).Value / 24
End If
End If
End If
Next
Next
Any help would be greatly appreciated.

[Bob Phillips]

Try changingh



If cell.Offset(0, 2).Value = "SHIFT" & cell.Offset(0, 4).Value = "YES" Then


to



If cell.Offset(0, 2).Value = "SHIFT" And cell.Offset(0, 4).Value = "YES" Then

[dakkat]

Thank you for the reply, but that resulted in the same outcome; code runs but no data is populating. Field is copied into clipboard though so the AND criteria seems to be working.

I have created a test sheet containing the code along with a sample of the tab (RAWDATA) and a tab that matches the name (EXAMPLE SHEET) to copy the data over to.

Hopefully this will help.

[shrivallabha]

Following code should work:
Sub TEST()

Dim r As Range, cell As Range, sh As Worksheet, shc As Worksheet
Dim lastrow As Long, c As Range, fDate As Date
With Worksheets("RAWDATA")
Set r = .Range(.Range("A7"), .Range("A7").End(xlDown))
End With
For Each cell In r
For Each sh In Worksheets
If LCase(sh.Name) <> "rawdata" Then
If sh.Cells(3, "D").Value = cell Then
If (cell.Offset(0, 2).Value = "SHIFT" And cell.Offset(0, 4).Value = "YES") = True Then
cell.Offset(0, 3).Copy
fDate = cell.Offset(0, 1).Value
Set shc = Sheets("EXAMPLE SHEET")
Set c = shc.Range("A12:A42").Find(fDate, LookIn:=xlValues, Lookat:=xlPart)
If Not c Is Nothing Then
shc.Range("B" & c.Row).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
End If
End If
End If
End If
Next
Next

End Sub

This way VBA can handle your "and" condition in better manner:
If (cell.Offset(0, 2).Value = "SHIFT" And cell.Offset(0, 4).Value = "YES") = True Then
When both conditions are true then it will execute further.

Then Second sheet was not set objectively. shc is added object.
Set shc = Sheets("EXAMPLE SHEET")
Set c = shc.Range("A12:A42").Find(fDate, LookIn:=xlValues, Lookat:=xlPart)
If Not c Is Nothing Then
shc.Range("B" & c.Row).PasteSpecial xlPasteValues


And finally, this code won't give you results :devil2: . That is because, the date formatting differs.

Some of the dates in raw data have:

1/1/2011 5:00:00 AM
And on the example sheets it is

1/1/2011
So find method fails. Set dates correctly.
Hth

[dakkat]

Thank you. The code was working but date was not matching so no data was being copied. I created a new date validation column field to strip the time by using "INT(A1)" and referencing this new field for the match.

I appreaciate everyones help!