update - copy paste with multiple criteria

[dbnfl]

Hello,

I have tried to modify code that I have that works with single criteria to double criteria, however my range is not correct. Could someone point me in the right direction.
I'm a truck driver trying to make my life easy for day to day operations of my business and only new to vba


Code I am tying to make work

Sub Vessel_Update_Sheet()

Dim c As Range, f As Range, sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Data")
Set sh2 = Sheets("Wharf Schedules")
For Each c In sh1.Range("C2" & "E2", sh1.Range("AR" & "AT" & Rows.Count).End(xlUp))
If c.Value <> "" Then
Set f = sh2.Range("AR:AR" & "AT:AT").Find(c.Value, , xlValues, xlWhole)
If Not f Is Nothing Then
sh1.Range("AP" & c.Row) = sh2.Range("G" & f.Row)
sh1.Range("AQ" & c.Row) = sh2.Range("I" & f.Row)
End If
End If
Next
MsgBox "Vessel details have been updated in main Data Sheet"
End Sub

Thank you in advance

 

[mumps]

Can you explain in words what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data?

 

[dbnfl]

hello,

thank you for your time.

Want to copy from sheet3("Wharf Schedules") columns G & I to sheet1("Data") columns AP & AQ if Sheet3("Wharf Schedules") Columns C & E match sheet1("Data") columns AR & AT
Sheet1("Data") AP = Sheet3("Wharf Schedules") G
Sheet1("Data) AQ = Sheet3("Wharf Schedules") I

 

[mumps]

Try:

Sub Vessel_Update_Sheet()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, arr1 As Variant, arr2 As Variant, i As Long, Val As String
    Set srcWS = Sheets("Wharf Schedules")
    Set desWS = Sheets("Data")
    arr1 = srcWS.Range("C2", srcWS.Range("C" & Rows.Count).End(xlUp)).Resize(, 7).Value
    arr2 = desWS.Range("AR2", desWS.Range("AR" & Rows.Count).End(xlUp)).Resize(, 3).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(arr2, 1)
            Val = arr2(i, 1) & "|" & arr2(i, 3)
            If Not .Exists(Val) Then
                .Add Val, Nothing
            End If
        Next i
        For i = 1 To UBound(arr1, 1)
            Val = arr1(i, 1) & "|" & arr1(i, 3)
            If .Exists(Val) Then
                desWS.Range("AP" & i + 1) = arr1(i, 5)
                desWS.Range("AQ" & i + 1) = arr1(i, 7)
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

 

[dbnfl]

When code runs it pastes not matching its like is paste same 5 cells over and over.

 

[mumps]

I tested the macro on some dummy data and it worked properly. I think that it would be easier to help and test possible solutions if I could work with your actual file. Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[dbnfl]

https://1drv.ms/x/s!Ah_y3HoNCprtbgg6RIXlxaZkfvw

 

[dbnfl]

module1

Sub Import_Vessel_Update_Sheet()

is what I want to modify

 

[mumps]

Columns AR and AT in "Data" sheet contain duplicate values. For example, "SPIRIT OF SINGAPORE 921S" exists many times. Also in the "Wharf Schedules" sheet you have the headers rows inserted mulitple times. In the "Data" sheet you also have some data in some columns in row 15070 and both sheets have many blank rows. All these factors can create problems, especially the duplicate values and headers.

 

[dbnfl]

is there a way round it.

there ca b up to 100 containers per vessel so here s going to be duplicate values.

also wharf schedule sheet there is 3 different wharfs thats why I have it paste like that.