Problem entering input box data to range after last row VBA

[KELLISM]

Hi all,

I am looking to add the Date entered via Input Box to the last pasted range without overwriting the data above.

I am new to VBA so my code tends to be trial and error. At present I can copy the data to the column but it is overwriting the original data. I cannot work out how to find the last row of column A and enter the date from the input box adjacent to the data entered in column B. Stopping if column B is empty.

Any help would be greatly appreciated.

Thanks in advance

Here is the code I am currently using

Sub InputDate()

 Dim strDate As String
 Dim answer As Integer
 
  strDate = InputBox("Insert date in format dd/mm/yy", "User date", Format(Now(), "dd/mm/yy"))
  
  answer = MsgBox("Is the Date Correct? " & strDate, vbYesNo + vbQuestion, "Correct Date")
  
  If answer = vbNo Then
    
 strDate = InputBox("Insert date in format dd/mm/yy", "User date", Format(Now(), "dd/mm/yy"))
 
 Else
 
  
  
  Dim rng As Range
    Dim i As Long


    'Set the range in column B to loop through
     Sheets("Data").Select
  Set rng = Range("B1:B10000")
  
       For Each cell In rng
        'test if cell is empty
        If cell.Value <> "" Then
            'write to adjacent cell
            cell.Offset(1, -1).Value = strDate
        End If
    Next
      
  End If
                    
  
  End Sub

 

[hennahairgel]

HTH

Sub InputDate()
    Dim strDate As String
    Dim answer As Integer
 
    strDate = InputBox("Insert date in format dd/mm/yy", "User date", Format(Now(), "dd/mm/yy"))
    answer = MsgBox("Is the Date Correct? " & strDate, vbYesNo + vbQuestion, "Correct Date")
  
    If answer = vbNo Then
        strDate = InputBox("Insert date in format dd/mm/yy", "User date", Format(Now(), "dd/mm/yy"))
    Else
        Worksheets("Data").Cells(Worksheets("Data").Cells.CurrentRegion.Rows.Count + 1, 2).Value = strDate
    End If
End Sub<