copy information in a row,after value changes(to another worksheet)

AJIESPEDAS

New Member
Joined
Jun 3, 2023
Messages
19
Office Version
  1. 2019
Platform
  1. MacOS
good day gentlemen,
im a excel noob trying to use vba to copy certain data to another worksheet.i have been trying all the vba line on the internet, and i cant seem to make it work like it suppose to. so Im stuck leaving to register to mr.excel to get help.
based on the picture i shared, local date dictate for a line 13 from (C13 to N13) to be copy to another worksheet (HOUR).each and everytime local date change in relation to the line 13, it will copy to HOUR worksheet to the next line without overwriting the previous one.
example

local date 01/01/23-shane bunyak , 00;40 and so on till line N13
local date 02/01/23-danial ,00;30 and so on till line N13

please help me, i have come to a dead end with my noob knowledge.
 

Attachments

  • Screenshot 2023-06-03 at 5.33.23 PM.png
    Screenshot 2023-06-03 at 5.33.23 PM.png
    98.4 KB · Views: 15

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Hi @AJIESPEDAS,

1. If Local Date value change, then it will check if staff name exist in hour(sheet), if exists then wont run anything. If not exists, then will put in the last row

Only focus on row 13?

P.S. : If you're using MacOS, You need to download source code(zip) link (Right click sheet1 -> View code -> Import File ( right click sheet1 left side) then find Dictionary.cls (to be able to use dictionary)

Book2
CDEFGHIJKLMN
6LOCAL DATE:6/8/2023
7
8
9
10Staff NoStaff NameP1P2p1/usTotal
11DayNightDayNightDayNight
12
13F00125wer0:400:070:090:101:06
14
15
Sheet1


Book2
ABCDEFGHIJKLMN
2LOCAL DATE6/4/2023F00125rud0:400:070:090:101:06
3LOCAL DATE6/8/2023F00125wer0:400:070:090:101:06
4
Hour


Right Click Sheet1 -> View Code -> Paste below code

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OldValue As Variant

If Target.Value = "" Then Exit Sub
If Target.Column = 8 And Target.Row = 6 Then 'H6

     Application.EnableEvents = False
     Application.Undo
     OldValue = Target.Value
     Application.Undo
     Application.EnableEvents = True
     If OldValue <> Target.Value And OldValue <> "" Then 'Detect If old and new date are different, If different then run the code
        Call test
     End If
End If

End Sub

Sub test()
Set dict = CreateObject("Scripting.Dictionary")

With Sheets("hour")
a = .Range("c2:l" & .Cells(Rows.Count, "a").End(xlUp).Row).Value
End With

For i = 1 To UBound(a, 1)
If Not dict.Exists(a(i, 2)) Then
    dict.Add a(i, 2), i
End If
Next i

b = Sheets("sheet1").Range("c13:n13").Value

For i = 1 To UBound(b, 1)
    If Not dict.Exists(b(i, 2)) Then
    With Sheets("hour")
        lrow = .Cells(Rows.Count, "c").End(xlUp).Row + 1
         .Cells(lrow, "a").Value = "LOCAL DATE"
        .Cells(lrow, "b").Value = Sheet1.[h6].Value
        .Cells(lrow, "c").Resize(1, UBound(b, 2)).Value = b
    End With
    End If
Next i


End Sub
 
Last edited:
Upvote 0
thanks for the reply RudRud, ill try vba and have a go, ill update you again, but thanks for the reply sir, this means alot!
 
Upvote 0
@r
Hi @AJIESPEDAS,

1. If Local Date value change, then it will check if staff name exist in hour(sheet), if exists then wont run anything. If not exists, then will put in the last row

Only focus on row 13?

P.S. : If you're using MacOS, You need to download source code(zip) link (Right click sheet1 -> View code -> Import File ( right click sheet1 left side) then find Dictionary.cls (to be able to use dictionary)

Book2
CDEFGHIJKLMN
6LOCAL DATE:6/8/2023
7
8
9
10Staff NoStaff NameP1P2p1/usTotal
11DayNightDayNightDayNight
12
13F00125wer0:400:070:090:101:06
14
15
Sheet1


Book2
ABCDEFGHIJKLMN
2LOCAL DATE6/4/2023F00125rud0:400:070:090:101:06
3LOCAL DATE6/8/2023F00125wer0:400:070:090:101:06
4
Hour


Right Click Sheet1 -> View Code -> Paste below code

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OldValue As Variant

If Target.Value = "" Then Exit Sub
If Target.Column = 8 And Target.Row = 6 Then 'H6

     Application.EnableEvents = False
     Application.Undo
     OldValue = Target.Value
     Application.Undo
     Application.EnableEvents = True
     If OldValue <> Target.Value And OldValue <> "" Then 'Detect If old and new date are different, If different then run the code
        Call test
     End If
End If

End Sub

Sub test()
Set dict = CreateObject("Scripting.Dictionary")

With Sheets("hour")
a = .Range("c2:l" & .Cells(Rows.Count, "a").End(xlUp).Row).Value
End With

For i = 1 To UBound(a, 1)
If Not dict.Exists(a(i, 2)) Then
    dict.Add a(i, 2), i
End If
Next i

b = Sheets("sheet1").Range("c13:n13").Value

For i = 1 To UBound(b, 1)
    If Not dict.Exists(b(i, 2)) Then
    With Sheets("hour")
        lrow = .Cells(Rows.Count, "c").End(xlUp).Row + 1
         .Cells(lrow, "a").Value = "LOCAL DATE"
        .Cells(lrow, "b").Value = Sheet1.[h6].Value
        .Cells(lrow, "c").Resize(1, UBound(b, 2)).Value = b
    End With
    End If
Next i


End Sub
hi RudRud, mainly i wanted to do both row 12 and 14 but at the moment i cant and dont know how to save the dictionary.cls file to the mac.
and can you help me to make row 12 and 14 as well but not mix with the row 13?
 
Upvote 0

click source code zip
1685799199285.png

1685799131949.png

1685799150214.png

1685799172630.png


After imported dictionary.cls into class module,

Right Click Sheet1 -> View Code -> Paste below code

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OldValue As Variant

If Target.Value = "" Then Exit Sub
If Target.Column = 8 And Target.Row = 6 Then 'H6

     Application.EnableEvents = False
     Application.Undo
     OldValue = Target.Value
     Application.Undo
     Application.EnableEvents = True
     If OldValue <> Target.Value And OldValue <> "" Then 'Detect If old and new date are different, If different then run the code
        Call test
     End If
End If

End Sub

Sub test()
dim dict as new dictionary

With Sheets("hour")
a = .Range("c2:l" & .Cells(Rows.Count, "a").End(xlUp).Row).Value
End With

For i = 1 To UBound(a, 1)
If Not dict.Exists(a(i, 2)) Then
    dict.Add a(i, 2), i
End If
Next i

b = Sheets("sheet1").Range("c13:n13").Value

For i = 1 To UBound(b, 1)
    If Not dict.Exists(b(i, 2)) Then
    With Sheets("hour")
        lrow = .Cells(Rows.Count, "c").End(xlUp).Row + 1
         .Cells(lrow, "a").Value = "LOCAL DATE"
        .Cells(lrow, "b").Value = Sheet1.[h6].Value
        .Cells(lrow, "c").Resize(1, UBound(b, 2)).Value = b
    End With
    End If
Next i


End Sub
 
Last edited:
Upvote 0

click source code zip
View attachment 92841
View attachment 92838
View attachment 92839
View attachment 92840

After imported dictionary.cls into class module,

Right Click Sheet1 -> View Code -> Paste below code

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OldValue As Variant

If Target.Value = "" Then Exit Sub
If Target.Column = 8 And Target.Row = 6 Then 'H6

     Application.EnableEvents = False
     Application.Undo
     OldValue = Target.Value
     Application.Undo
     Application.EnableEvents = True
     If OldValue <> Target.Value And OldValue <> "" Then 'Detect If old and new date are different, If different then run the code
        Call test
     End If
End If

End Sub

Sub test()
dim dict as new dictionary

With Sheets("hour")
a = .Range("c2:l" & .Cells(Rows.Count, "a").End(xlUp).Row).Value
End With

For i = 1 To UBound(a, 1)
If Not dict.Exists(a(i, 2)) Then
    dict.Add a(i, 2), i
End If
Next i

b = Sheets("sheet1").Range("c13:n13").Value

For i = 1 To UBound(b, 1)
    If Not dict.Exists(b(i, 2)) Then
    With Sheets("hour")
        lrow = .Cells(Rows.Count, "c").End(xlUp).Row + 1
         .Cells(lrow, "a").Value = "LOCAL DATE"
        .Cells(lrow, "b").Value = Sheet1.[h6].Value
        .Cells(lrow, "c").Resize(1, UBound(b, 2)).Value = b
    End With
    End If
Next i


End Sub
manage to follow to put the dictionary.cls to class module, but when run it shows in the picture
 
Upvote 0
is there any way to share my excel file to you sir?

Hi, Try to upload through Google Drive / Dropbox and share the link here,

Data set with expected result both will be good.
 
Upvote 0
Hi, Try to upload through Google Drive / Dropbox and share the link here,

Data set with expected result both will be good.
try have a go sir, hours need to be collected with respected crewname and date flown, if possible not mix up with line 12 and 14, i think the rest i can do a filter
 
Upvote 0
Hi @AJIESPEDAS, Code will start run If H6 Value is different with previous H6 Value (For example last input 6/7/2023 then you change into 6/8/2023) , Therefore code will start checking row 12 and row 14 see if existing in Hour(sheet), If not exists then will paste into it.

Right click voyage report -> View code -> paste the below code

Normally, You willl change date first then input staff name? or how? see if you need other adjustment :)

1685851729405.png


VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OldValue As Variant

If Target.Value = "" Then Exit Sub
If Target.Column = 8 And Target.Row = 6 Then 'H6

     Application.EnableEvents = False
     Application.Undo
     OldValue = Target.Value
     Application.Undo
     Application.EnableEvents = True
     If OldValue <> Target.Value And OldValue <> "" Then 'Detect If old and new date are different, If different then run the code
        Call test
     End If
End If

End Sub

Sub test()
Dim dict As New Dictionary

With Sheets("hour")
A = .Range("c2:l" & .Cells(Rows.Count, "a").End(xlUp).Row).Value
End With

For i = 1 To UBound(A, 1)
If Not dict.Exists(A(i, 2)) Then
    dict.Add A(i, 2), i
End If
Next i

B = Sheets("Voyage report").Range("c12:n14").Value 'row 12 - 14

For i = 1 To UBound(B, 1)
    If i <> 2 Then 'except row13 - starting 12 13 14 which is 2
    If Not dict.Exists(B(i, 2)) Then
    With Sheets("hour")
        lrow = .Cells(Rows.Count, "g").End(xlUp).Row + 1
         .Cells(lrow, "a").Value = "LOCAL DATE"
        .Cells(lrow, "b").Value = Sheet1.[h6].Value
        .Cells(lrow, "c").Resize(1, UBound(B, 2)).Value = B
    End With
    End If
    End If
Next i


End Sub
 
Upvote 0

Forum statistics

Threads
1,215,148
Messages
6,123,301
Members
449,095
Latest member
Chestertim

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