Auto date every other cell with existing VBA

PuntingJawa

New Member
Joined
Feb 25, 2021
Messages
45
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
OP-AUX Database Test(MacroEnabled).xlsm
ABCDE
1L1DateR1DateL3
2#CALC!#CALC!#CALC!
3
4
5
6
7
LOG

As of right now I have a VBA code that pulls certain columns from several sheets and special pastes in another while removing duplicates. I'd like to expand on this and add to the code to auto date in a column next to it.
Example.
Data gets placed in cell A2. I'd like the macro to go one step further and place a date in cell B2.
C2 data -D2 date
E2 data -F2 date
And so on. I'll place my vba code at the bottom.
VBA Code:
Private Sub Worksheet_Activate()
 Sheet2.Range("K2", Sheet2.Range("K" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("A2", Sheet19.Range("A" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet2.Range("L2", Sheet2.Range("L" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("c1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("c2", Sheet19.Range("c" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 
 Sheet3.Range("B2", Sheet3.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("e1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("e2", Sheet19.Range("e" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet3.Range("C2", Sheet3.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("g1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("g2", Sheet19.Range("g" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 
 Sheet4.Range("B2", Sheet4.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("i1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("i2", Sheet19.Range("i" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet4.Range("C2", Sheet4.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("k1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("k2", Sheet19.Range("k" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 
 Sheet5.Range("B2", Sheet5.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("m1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("m2", Sheet19.Range("m" & Rows.Count).End(xlUp)).RemoveDuplicates 1

 Sheet6.Range("B2", Sheet6.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("o1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("o2", Sheet19.Range("o" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet6.Range("C2", Sheet6.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("q1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("q2", Sheet19.Range("q" & Rows.Count).End(xlUp)).RemoveDuplicates 1

 Sheet7.Range("B2", Sheet7.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("s1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("s2", Sheet19.Range("s" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet7.Range("C2", Sheet7.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("u1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("u2", Sheet19.Range("u" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 
 Sheet8.Range("B2", Sheet8.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("w1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("w2", Sheet19.Range("w" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet8.Range("C2", Sheet8.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("y1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("y2", Sheet19.Range("y" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 
 Sheet9.Range("B2", Sheet9.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("aa1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("aa2", Sheet19.Range("aa" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet9.Range("C2", Sheet9.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ac1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ac2", Sheet19.Range("ac" & Rows.Count).End(xlUp)).RemoveDuplicates 1

 Sheet10.Range("B2", Sheet10.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ae1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ae2", Sheet19.Range("ae" & Rows.Count).End(xlUp)).RemoveDuplicates 1

 Sheet11.Range("B2", Sheet11.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ag1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ag2", Sheet19.Range("ag" & Rows.Count).End(xlUp)).RemoveDuplicates 1


 Sheet12.Range("B2", Sheet12.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ai1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ai2", Sheet19.Range("Ai" & Rows.Count).End(xlUp)).RemoveDuplicates 1

 Sheet13.Range("B2", Sheet13.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ak1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ak2", Sheet19.Range("Ak" & Rows.Count).End(xlUp)).RemoveDuplicates 1

 Sheet14.Range("H2", Sheet14.Range("H" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Am1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Am2", Sheet19.Range("Am" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet14.Range("I2", Sheet14.Range("I" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ao1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ao2", Sheet19.Range("Ao" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 
 Sheet15.Range("B2", Sheet15.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Aq1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Aq2", Sheet19.Range("Aq" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet15.Range("C2", Sheet15.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("As1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("As2", Sheet19.Range("As" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 
 Sheet16.Range("K2", Sheet16.Range("K" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Au1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Au2", Sheet19.Range("Au" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet16.Range("L2", Sheet16.Range("L" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Aw1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Aw2", Sheet19.Range("Aw" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet16.Range("M2", Sheet16.Range("M" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ay1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ay2", Sheet19.Range("Ay" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 
 Sheet17.Range("B2", Sheet17.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ba1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ba2", Sheet19.Range("ba" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet17.Range("C2", Sheet17.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("bc1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("bc2", Sheet19.Range("bc" & Rows.Count).End(xlUp)).RemoveDuplicates 1
End Sub
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
64,092
Office Version
  1. 365
Platform
  1. Windows
You can do that like
VBA Code:
 Sheet2.Range("K2", Sheet2.Range("K" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("A2", Sheet19.Range("A" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("B2:B" & Sheet19.Range("A" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet2.Range("L2", Sheet2.Range("L" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("c1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("c2", Sheet19.Range("c" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("D2:D" & Sheet19.Range("c" & Rows.Count).End(xlUp).Row).Value = Date
 
Solution

PuntingJawa

New Member
Joined
Feb 25, 2021
Messages
45
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Thank you! I was using all kinds of work arounds to try and get this to work but nothing was doing the job with my existing VBA. My next project will be to figure out how to use my current VBA code to log to a different workbook so I can separate it.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
64,092
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Forum statistics

Threads
1,144,575
Messages
5,725,088
Members
422,590
Latest member
Mikeyyy

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
Top