[vba] Add timestamp to LastRow

zeromax1

New Member
Joined
Mar 20, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
Hi all, I write an VBA that need to copy a filtered data from sheet a to sheet b, I want to add the timestamp to the right column on sheet b. However, the vba only add 1row time stamp for each paste action. The timestamp cannot past till to the last row.

Below are part of my VBA code

VBA Code:
Sub Transpose()

Dim whs, whs2 As Worksheet
Dim lastrow2, lastrow3 As Long
Dim i As Integer


Set whs = ThisWorkbook.Worksheets("sheet1")
Set whs2 = ThisWorkbook.Worksheets("sheet2")

lastrow2 = whs2.Range("D" & whs2.Rows.Count).End(xlUp).Row
lastrow3 = wrs.Range("B" & wrs.Rows.Count).End(xlUp).Row


    whs.Activate
    
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
        
    wrs.Range("J6").AutoFilter field:=10, Criteria1:="<>", Operator:=xlFilterValues
    
    wrs.Range("B7:C" & lastrow3 & "," & "I7:K" & lastrow3).SpecialCells(xlCellTypeVisible).Copy Destination:=rcod.Cells(lastrow2 + 1, 4)

    For i = 2 To Lastrow
   
    If rcod.Cells(i, "D").Value <> "" And rcod.Cells(i, "E").Value <> "" And rcod.Cells(i, "F").Value <> "" And rcod.Cells(i, "G").Value <> "" And rcod.Cells(i, "H").Value <> "" Then
    
    rcod.Cells(i + 1, "I").Value = Date
    rcod.Cells(i + 1, "I").NumberFormat = "mm/dd/yy"
    
    End If
    
    Next i

    Application.CutCopyMode = False
      

End Sub

How can I fill the timestamp to each row when I copy the visible data from sheet A to sheet B? Many Thanks.

1597068043119.png
 

Some videos you may like

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,732
Office Version
  1. 2010
Platform
  1. Windows
I think your problem is that LASTROW is not set to anything. I think you need something like
VBA Code:
LastRow = rcod.Cells(Rows.Count, "A").End(xlUp).Row - lastrow2
however I am not sure what you are trying to do.
 

zeromax1

New Member
Joined
Mar 20, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
I think your problem is that LASTROW is not set to anything. I think you need something like
VBA Code:
LastRow = rcod.Cells(Rows.Count, "A").End(xlUp).Row - lastrow2
however I am not sure what you are trying to do.

I only rewrite for the truth information. I still got one time stamp only.

VBA Code:
Sub Transpose()

Dim whs, whs2 As Worksheet
Dim lastrow2, lastrow3 As Long
Dim i As Integer


Set whs = ThisWorkbook.Worksheets("sheet1")
Set whs2 = ThisWorkbook.Worksheets("sheet2")

lastrow2 = whs2.Range("D" & whs2.Rows.Count).End(xlUp).Row
lastrow3 = wrs.Range("B" & wrs.Rows.Count).End(xlUp).Row


    whs.Activate
    
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
        
    wrs.Range("J6").AutoFilter field:=10, Criteria1:="<>", Operator:=xlFilterValues
    
    wrs.Range("B7:C" & lastrow3 & "," & "I7:K" & lastrow3).SpecialCells(xlCellTypeVisible).Copy Destination:=wrs2.Cells(lastrow2 + 1, 4)

    For i = 2 To Lastrow
   
    If wrs2.Cells(i, "D").Value <> "" And wrs2.Cells(i, "E").Value <> "" And wrs2.Cells(i, "F").Value <> "" And wrs2.Cells(i, "G").Value <> "" And wrs2.Cells(i, "H").Value <> "" Then
    
    wrs2.Cells(i + 1, "I").Value = Date
    wrs2.Cells(i + 1, "I").NumberFormat = "mm/dd/yy"
    
    End If
    
    Next i

    Application.CutCopyMode = False
      

End Sub
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,732
Office Version
  1. 2010
Platform
  1. Windows
Yes because you still haven't set lastrow to anything!! You have got lastrow2 and lastrow3 but NOT lastrow
this is the line that has got the problem:
VBA Code:
For i = 2 To Lastrow
 

Watch MrExcel Video

Forum statistics

Threads
1,127,658
Messages
5,626,138
Members
416,165
Latest member
hamburger138

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