update - copy paste with multiple criteria

D

dbnfl

Board Regular
Joined
Aug 11, 2019
Messages
59
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
 
Sort by date Sort by votes
Try:
Code: 
Sub Import_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, RngList As Object
    Set srcWS = Sheets("Wharf Schedules")
    Set desWS = Sheets("Data")
    arr1 = srcWS.Range("B6", srcWS.Range("I" & Rows.Count).End(xlUp)).Resize(, 8).Value
    arr2 = desWS.Range("AO5", desWS.Range("AT" & Rows.Count).End(xlUp)).Resize(, 6).Value
    Set RngList = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr2, 1)
        If arr2(i, 4) <> "" Then
            Val = arr2(i, 1) & "|" & arr2(i, 4) & "|" & arr2(i, 6)
            If Not RngList.Exists(Val) Then
                RngList.Add Key:=Val, Item:=i + 4
            End If
        End If
    Next i
    For i = 1 To UBound(arr1, 1)
        If arr1(i, 2) <> "" Then
            Val = arr1(i, 1) & "|" & arr1(i, 2) & "|" & arr1(i, 4)
            If RngList.Exists(Val) Then
                desWS.Range("AP" & RngList(Val)) = arr1(i, 6)
                desWS.Range("AQ" & RngList(Val)) = arr1(i, 8)
            End If
        End If
    Next i
    Application.ScreenUpdating = True
  MsgBox "Vessel details have been updated in main Data Sheet"
End Sub
 
Upvote 0

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Hello,

Thank you for reply. I pasted in and I runs but does not copy and paste.

What I'm trying to do.


Want to transfer data from Sheet3(“Wharf Schedules”) toSheet1(“Data”)





If Sheet3(“Wharf Schedules”) columns C & E match withSheet1(“Data”) columns AR & AT (C to match with AR & E to match withAT), if match copy Sheet3(“Wharf Schedules”) Columns B, D, G & I and pasteto Sheet1(“Data”) AO, AS, AP & AQ.





Sheet3(“Wharf Schedules”) Column B to Sheet1(“Data”) ColumnAO


Sheet3(“Wharf Schedules”) Column D to Sheet1(“Data”) ColumnAS


Sheet3(“Wharf Schedules”) Column G to Sheet1(“Data”) ColumnAP


Sheet3(“Wharf Schedules”) Column I to Sheet1(“Data”) ColumnAQ





As Sheet3(Wharf Schedules”) is updated consitanlty I don’twant to delete Sheet1(“Data”) entries if they are already in columns AO, AS, AP& AQ, only want to update if a match is found. Sheet3(Wharf Schedules”) Ipaste updated info over current info. Hope this makes sense.




Sub Import_Vessel_Update2_Sheet()

Application.ScreenUpdating = False

Dim srcWS As Worksheet
Dim desWS As Worksheet
Dim arr1 As Variant
Dim arr2 As Variant
Dim i As Long
Dim Val As String
Dim RngList As Object

Set srcWS = Sheets("Wharf Schedules")
Set desWS = Sheets("Data")
arr1 = srcWS.Range("B6", srcWS.Range("I" & Rows.Count).End(xlUp)).Resize(, 8).Value
arr2 = desWS.Range("AO5", desWS.Range("AT" & Rows.Count).End(xlUp)).Resize(, 6).Value
Set RngList = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr2, 1)
If arr2(i, 4) <> "" Then
Val = arr2(i, 1) & "|" & arr2(i, 4) & "|" & arr2(i, 6)
If Not RngList.Exists(Val) Then
RngList.Add Key:=Val, Item:=i + 4
End If
End If
Next i
For i = 1 To UBound(arr1, 1)
If arr1(i, 2) <> "" Then
Val = arr1(i, 1) & "|" & arr1(i, 2) & "|" & arr1(i, 4)
If RngList.Exists(Val) Then
desWS.Range("AO" & RngList(Val)) = arr1(i, 1)
desWS.Range("AP" & RngList(Val)) = arr1(i, 6)
desWS.Range("AQ" & RngList(Val)) = arr1(i, 8)
desWS.Range("AS" & RngList(Val)) = arr1(i, 3)
End If
End If
Next i
Application.ScreenUpdating = True
MsgBox "Vessel details have been updated in main Data Sheet"
End Sub
 
Upvote 0
When you say "Ipaste updated info over current info", do you mean that if columns AO, AS, AP & AQ already have data in the "Data" sheet, you don't want to overwrite that data? In other words, you only want to copy/paste the data in columns AO, AS, AP & AQ if they are blank with no data. Is this correct?
 
Upvote 0
hello,

When I enter new job, columns AO, AS, AP & AQ will be blank. When click Update Vessel ETA Details button on Sheet3("Wharf Schedules"), I want Columns to fill and update other cells that match criteria. Vessel ETA's change all the time, so I need o keep updating main Sheet1("Data").

Want to transfer data from Sheet3(“Wharf Schedules”) toSheet1(“Data”)

If Sheet3(“Wharf Schedules”) columns C & E match withSheet1(“Data”) columns AR & AT (C to match with AR & E to match withAT), if match copy Sheet3(“Wharf Schedules”) Columns B, D, G & I and pasteto Sheet1(“Data”) AO, AS, AP & AQ.

Sheet3(“Wharf Schedules”) Column B to Sheet1(“Data”) ColumnAO
Sheet3(“Wharf Schedules”) Column D to Sheet1(“Data”) ColumnAS
Sheet3(“Wharf Schedules”) Column G to Sheet1(“Data”) ColumnAP
Sheet3(“Wharf Schedules”) Column I to Sheet1(“Data”) ColumnAQ

Sheet1("Data")
1 - If cell is blank and criteria matches fill cell.
2 - If cell already contains data and criteria matches update cell
3 - If cell already contains data and criteria doesn't match leave current data in cell.

I hope this explains better.

Dale.
2 -
 
Upvote 0
Try:
Code: 
Sub Import_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, RngList As Object
    Set srcWS = Sheets("Wharf Schedules")
    Set desWS = Sheets("Data")
    arr1 = srcWS.Range("B6", srcWS.Range("I" & Rows.Count).End(xlUp)).Resize(, 8).Value
    arr2 = desWS.Range("AO5", desWS.Range("AT" & Rows.Count).End(xlUp)).Resize(, 6).Value
    Set RngList = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr2, 1)
        If arr2(i, 4) <> "" Then
            Val = arr2(i, 1) & "|" & arr2(i, 4) & "|" & arr2(i, 6)
            If Not RngList.Exists(Val) Then
                RngList.Add Key:=Val, Item:=i + 4
            End If
        End If
    Next i
    For i = 1 To UBound(arr1, 1)
        If arr1(i, 2) <> "" Then
            Val = arr1(i, 1) & "|" & arr1(i, 2) & "|" & arr1(i, 4)
            If RngList.Exists(Val) Then
                desWS.Range("AO" & RngList(Val)) = arr1(i, 1)
                desWS.Range("AS" & RngList(Val)) = arr1(i, 3)
                desWS.Range("AP" & RngList(Val)) = arr1(i, 6)
                desWS.Range("AQ" & RngList(Val)) = arr1(i, 8)
            End If
        End If
    Next i
    Application.ScreenUpdating = True
  MsgBox "Vessel details have been updated in main Data Sheet"
End Sub
 
Upvote 0
Hello,

Sorry for the delay thank you. Got side tracked wit some other work stuff.

I've pasted the last code an it still wont copy and paste.

I've put on cloud if you could see if I'm doing something wrong it would be greatly appreciated.

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

Code is on Module1

Sub Import_Vessel_Update2_Sheet()

I just play it in code. I haven't attached it to button on Sheet3"Wharf Schedules" as yet.

Regards,

Dale.
 
Upvote 0
Can any vessel with the same name and "In Voyage" number be listed in more than one wharf?
 
Upvote 0
not the same vessel name/voyage number.

you can get the same voyage number at different wharfs but they are different vessel names.
 
Upvote 0
This seems to be working:
Code: 
Sub Import_Vessel_Update2_Sheet()
   Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, arr1 As Variant, arr2 As Variant, i As Long, Val As String, RngList As Object
    Set srcWS = Sheets("Wharf Schedules")
    Set desWS = Sheets("Data")
    arr1 = srcWS.Range("B6", srcWS.Range("I" & Rows.Count).End(xlUp)).Resize(, 8).Value
    arr2 = desWS.Range("AO5", desWS.Range("AT" & Rows.Count).End(xlUp)).Resize(, 6).Value
    Set RngList = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr2, 1)
        If arr2(i, 4) <> "" Then
            Val = arr2(i, 4) & "|" & arr2(i, 6)
            If Not RngList.Exists(Val) Then
                RngList.Add Key:=Val, Item:=i + 4
            End If
        End If
    Next i
    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 2) & "|" & arr1(i, 4)
        If RngList.Exists(Val) Then
            desWS.Range("AO" & RngList(Val)) = arr1(i, 1)
            desWS.Range("AS" & RngList(Val)) = arr1(i, 3)
            desWS.Range("AP" & RngList(Val)) = arr1(i, 6)
            desWS.Range("AQ" & RngList(Val)) = arr1(i, 8)
        End If
    Next i
    Application.ScreenUpdating = True
  MsgBox "Vessel details have been updated in main Data Sheet"
End Sub
 
Last edited:
Upvote 0
Hello,

Sorry for the delayed responded. Been out on the road.

I’ve put the code in as per your code and its working butdoing the below.

Its not finding all vessel data. I’ve tried copying andpasting to make sure names are same and still no difference. If there is multiplyjobs with same vessel/Voyage its only copying for first job.
Wharf
 ETA
 ETD
 Vessel
 Lloyds
 In Voyage
29/06/2019 11:47​
29/06/2019​
 3/07/2019
DP World
27/06/2019 22:00​
29/06/2019 11:00​
 CMA CGM NEW JERSEY
9351141​
 101S
29/06/2019 11:47​
29/06/2019 0:00​
3/07/2019 0:00​

CMA CGM NEW JERSEY
101S


DP World
27/06/2019 14:00​
28/06/2019 22:00​
 CMA CGM CORNEILLE
9409170​
 9019


DP World
26/06/2019 6:00​
27/06/2019 14:00​
 XIN QING DAO
9270452​
 187S














CMA CGM NEW JERSEY
101S


Patricks
28/06/2019 15:10​
29/06/2019 15:00​
 SPIRIT OF SINGAPORE
9362396​
 921S





SPIRIT OF SINGAPORE
921S





SPIRIT OF SINGAPORE
921S





SPIRIT OF SINGAPORE
921S


Patricks
17/06/2019 7:06​
18/06/2019 6:15​
 MAERSK GANGES
9694581​
 917W





MAERSK GANGES
917W


DP World
23/06/2019 14:00​
24/06/2019 22:00​
 YM VANCOUVER
9363364​
 124S





YM VANCOUVER
124S









































XIN QING DAO
187S


DP World
30/06/2019 14:00​
1/07/2019 22:00​
 EVER DEVELOP
9142174​
 139S





EVER DEVELOP
139S





EVER DEVELOP
139S





SPIRIT OF SINGAPORE
921S














SPIRIT OF SINGAPORE
921S





SPIRIT OF SINGAPORE
921S


Patricks
29/06/2019 23:06​
30/06/2019 17:00​
 OOCL HOUSTON
9355757​
 149S





SPIRIT OF SINGAPORE
921S






































Patricks
1/07/2019 15:06​
2/07/2019 17:00​
 OOCL LE HAVRE
9404857​
 108S





SPIRIT OF SINGAPORE
921S





OOCL LE HAVRE
108S





YM VANCOUVER
124S





OOCL SEOUL
058S


<tbody> </tbody>

Codes
Sub Import_Vessel_ETA_Update_Sheet()
Application.ScreenUpdating = False
Dim srcWS AsWorksheet, desWS As Worksheet, arr1 As Variant, arr2 As Variant, i As Long, ValAs String, RngList As Object
Set srcWS =Sheets("Wharf Schedules")
Set desWS =Sheets("Data")
arr1 =srcWS.Range("B6", srcWS.Range("S" &Rows.Count).End(xlUp)).Resize(, 8).Value
arr2 =desWS.Range("AO5", desWS.Range("AT" &Rows.Count).End(xlUp)).Resize(, 6).Value
Set RngList =CreateObject("Scripting.Dictionary")
For i = 1 ToUBound(arr2, 1)
If arr2(i, 4)<> "" Then
Val =arr2(i, 4) & "|" & arr2(i, 6)
If NotRngList.Exists(Val) Then
RngList.Add Key:=Val, Item:=i + 4
End If
End If
Next i
For i = 1 ToUBound(arr1, 1)
Val = arr1(i,2) & "|" & arr1(i, 4)
IfRngList.Exists(Val) Then
desWS.Range("AO" & RngList(Val)) = arr1(i, 1)
desWS.Range("AS" & RngList(Val)) = arr1(i, 3)
desWS.Range("AP" & RngList(Val)) = arr1(i, 6)
desWS.Range("AQ" & RngList(Val)) = arr1(i, 8)
End If
Next i
Application.ScreenUpdating = True
MsgBox "VesselETA & ETD dates have been updated on main Data Sheet"
End Sub

Sub Import_Vessel_Availabilty_Update_Sheet()
Application.ScreenUpdating = False
Dim srcWS AsWorksheet, desWS As Worksheet, arr1 As Variant, arr2 As Variant, i As Long, ValAs String, RngList As Object
Set srcWS =Sheets("Wharf Schedules")
Set desWS =Sheets("Data")
arr1 =srcWS.Range("L6", srcWS.Range("S" &Rows.Count).End(xlUp)).Resize(, 8).Value
arr2 =desWS.Range("AR5", desWS.Range("AW" &Rows.Count).End(xlUp)).Resize(, 6).Value
Set RngList =CreateObject("Scripting.Dictionary")
For i = 1 ToUBound(arr2, 1)
If arr2(i, 1)<> "" Then
Val =arr2(i, 1) & "|" & arr2(i, 3)
If NotRngList.Exists(Val) Then
RngList.Add Key:=Val, Item:=i + 3
End If
End If
Next i
For i = 1 ToUBound(arr1, 1)
Val = arr1(i,2) & "|" & arr1(i, 4)
IfRngList.Exists(Val) Then
desWS.Range("AU" &RngList(Val)) = arr1(i, 6)
desWS.Range("AV" & RngList(Val)) = arr1(i, 7)
desWS.Range("AW" & RngList(Val)) = arr1(i, 8)
End If
Next i
Application.ScreenUpdating = True
MsgBox "VesselAvailability details have been updated on main Data Sheet"
End Sub
Thank you heaps for your help.

Dale
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Copy a column value when the values match to multiple sheets of the workbook
Replies
1
Views
442
sofas
S
redspanna
  • Question Question
Merge 2 VB codes and add Application.screenupdating
Replies
2
Views
517
Bosquedeguate
Bosquedeguate
H
  • Solved
VBA to Copy a worksheet from a template, then increment a drop down list in each new copy by one.
2
Replies
10
Views
2K
kevin9999
K
J
  • Question Question
VBA Help: Macro finds text string, but need it to find whole words ONLY
Replies
5
Views
1K
DanteAmor
DanteAmor
L
  • Solved
Run Dictionary Script & Find based on multiple criteria
Replies
7
Views
616
DanteAmor
DanteAmor

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top