Assistance with adding if then logic to working VBA script.

[evenyougreg]

I am looking to add some basic logic to my existing VBA script that copies over cell contents from one spreadsheet to another if a condition is met. I didn't come up with the script, I had a lot of help, so I'm not sure how to incorporate the new logic.

The script as it stands right now does this:

If spreadsheet "OLD.xlsx" finds a string match in spreadsheet "NEW.xlsx" in column A, then the contents of columns E, H, I, J and K are copied over from OLD to NEW, row for row all the way until the end.

Sub Copy()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range
Set sh1 = Workbooks("OLD.xlsx").Sheets("list")
Set sh2 = Workbooks("NEW.xlsx").Sheets("list")
    For Each c In sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp))
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                c.Offset(, 4).Resize(, 2).Copy fn.Offset(, 4)
                c.Offset(, 7).Resize(, 4).Copy fn.Offset(, 7)
            End If
        Set fn = Nothing
    Next
End Sub

Works super well, except I have a new requirement as I mentioned. And that is, if column B does not have the text "NOT FOUND" in it, then I only need the following chunk of code ran which accounts for H I J K, leaving out E.

                c.Offset(, 7).Resize(, 4).Copy fn.Offset(, 7)

And if it does, than the original 2 lines are to be ran, which are E H I J K.

                c.Offset(, 4).Resize(, 2).Copy fn.Offset(, 4)
                c.Offset(, 7).Resize(, 4).Copy fn.Offset(, 7)

Hopefully that makes sense, and thanks in advance!

Greg

 

[Fluff]

Which sheet do you need to check for Not Found?
Also you code is copying col E & F, along with H:K, should col F still be copied?

 

[evenyougreg]

Oh interesting, I had no idea F was being copied! No, F should not be copied, thanks for catching that. To answer your question, if the "NEW" spreadsheet has "NOT FOUND" anywhere in column B.

Thanks!

 

[Fluff]

Ok, how about

Sub Copy()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range
Set sh1 = Workbooks("OLD.xlsx").Sheets("list")
Set sh2 = Workbooks("NEW.xlsx").Sheets("list")
    For Each c In sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp))
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                If fn.Offset(, 1) = "NOT FOUND" Then c.Offset(, 4).Copy fn.Offset(, 4)
                c.Offset(, 7).Resize(, 4).Copy fn.Offset(, 7)
            End If
        Set fn = Nothing
    Next
End Sub

 

[evenyougreg]

That's exactly what I needed.

Thank. you. so. much.

Greg

 

[Fluff]

You're welcome & thanks for the feedback.