Enter Date via textbox without overwriting previous data

[Kellis]

Hi,

I have data that the user imports to the data sheet, I have a text box where they enter the appropriate date. I would like this date to populate column A next to the imported data. With each import the date should be different. Not overwrite the previous dates in column A.

I just cannot get the text box to copy to the correct range without overwriting the previous dates. I am not very good with VBA but I am learning. If you are able to help can you explain how I set the correct range.

Thanks in advance

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
  Sheets("Data").Select
 
     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

 

[Hareesh_KLD]

Hi Try this

cell.Offset(1, -1).Value = cell.Offset(1, -1).Value & "," & strDat

if it is not worked, pls upload sample workbook

 

[NARAYANK991]

Hi ,

See if this is OK.

Sub InputDate()
    Dim DataRng As Range , DatesRng As Range
    Dim strDate As String
    Dim answer As Integer
    Dim lastrowofdata As Long , lastrowofdates As Long

GetDate:
    strDate = InputBox("Insert date in format dd/mm/yyyy", "User date", Format(Now(), "dd/mm/yyyy"))
    answer = MsgBox("Is the Date Correct? " & strDate, vbYesNoCancel + vbQuestion, "Correct Date")
    If answer = vbNo Then
      strDate = InputBox("Insert date in format dd/mm/yyyy", "User date", Format(Now(), "dd/mm/yyyy"))
      GoTo GetDate:
    End If
   
    If answer <> vbCancel Then
      Sheets("Data").Select
      lastrowofdata = Range("B" & Rows.Count).End(xlUp).Row
      If lastrowofdata = 1 Then lastrowofdata = 2
     
      lastrowofdates = Range("A" & Rows.Count).End(xlUp).Row + 1
     
      Set DataRng = Range("B1:B" & lastrowofdata)
      Set DatesRng = Range("A" & lastrowofdates & ":" & "A" & lastrowofdata)
      DatesRng.Value = strDate
    End If
End Sub

Narayan

 

[Kellis]

Hi Narayank991,

You have come to my rescue again.

This is great. If I want to add this code to another procedure should I rewrite the original sub with this code included or just Call the procedure, which works well, just not sure if it is best practice.

Thank you very much.

 

[NARAYANK991]

Hi ,

There is nothing wrong in calling this procedure from your main program ; however , you need to remember that this procedure operates only on the worksheet tab named Data ; if the main program is also involved in processing other data on this same worksheet tab , there is really no problem in calling this procedure from the main program.

Narayan

 

[Kellis]

Hi Narayan,

Wonder if you can help again. The date format seems to have changed I haven't changed the code! I enter the date DD/MM/YYYY, when it copies to the Data tab the date changes to MM/DD/YYYY. It is driving me round the bend, I haven't changed the formatting on the sheet or anything.