Help with For/If/Msgbox

[W R]

Hi all,

I have used answers on this site to help my Excel sheets for about 10 years now but finally need to post my specific problem as I cannot seem to tweak the things I see to work for me.

What I have is an workbased activity tracker eg. Calls made, calls answered, emails etc.

At the end of the day I have a macro that I click and this data is pasted in to a table on another sheet, I also have a failsafe to run the macro when I close excel in the event that I haven't copied the data over.

Currently the code is as follows (which I think I got from here);

Sub CopyData()
'
' CopyData Macro
'

'
    Sheets("Sheet1").Select
    Range("C21:L21").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Dim ws As Worksheet
    Set ws = ActiveSheet
    For Each cell In ws.Columns(1).Cells
        If IsEmpty(cell) = True Then cell.Select: Exit For
    Next cell
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

This works great to look for the first empty cell at the bottom of the date column and insert the data.

Here is what I would like it to do:

1. IF there is already an entry for [date in cell F2 in sheet1] in Column1 (in sheet2) THEN pop up msgbox to ask if you would like to Overwrite the Data, [YES] - overwrites row with same date then exit the sub, [No] - writes data in new row, [Cancel] - Do nothing and Exit Sub.
2. ELSE Continue to have the macro insert the data in the first blank row.

Ideally the buttons on the msgbox would be "Overwrite Data" - "New entry" - "Cancel" but I think that would need a lot more code which would make it more complicated for my little brain to understand!

Thanks all.

 

[Zot]

Looks like your code copy range C21 to L21 on sheet1 and then paste to empty row in sheet2 and finished.

Only 1 range of data to be copied?

 

[W R]

Hi Zot,

Yes this is correct.

It is just one range of data.

It is just a crude daily log of activity. It works fine but I like to make things idiot proof and incase I offer it out to more people.

 

[Zot]

I don't think you can customized MsgBox button caption. They can only be Yes No, Cancel, Retry, Ignore, Abort ... something fixed

In you case it will be asking another question after answering one

Something else not understood here. You said in Sheet1 the date is in F2. You are comparing with column A in Sheet2 but then you copy range C21:L21 on Sheet1 to column A on Sheet2. Then how can column A be date in Sheet2? I missed something here?

 

[dmt32]

Hi,

try following update to your code & see if does what you want

Sub CopyData()
    Dim ws1         As Worksheet, ws2 As Worksheet
    Dim m           As Variant, checkdate As Variant
    Dim RecordRow   As Long
    Dim Response    As VbMsgBoxResult
    '
    ' CopyData Macro
    '
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    
    'check for date in cell
    checkdate = ws1.Range("F2").Value
    
    RecordRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
    
    If IsDate(checkdate) Then
        'check for matching date in range
        m = Application.Match(CLng(checkdate), ws2.Columns(1), 0)
        
        'inform user
        If Not IsError(m) Then
            Response = MsgBox("Date Exists  Do You Want To Overwrite the Data?", 291, "Date Exists")
            If Response = vbCancel Then Exit Sub Else If Response = vbYes Then RecordRow = CLng(m)
        End If
    End If
    
    'copy range
    ws1.Range("C21:L21").Copy
    ws2.Cells(RecordRow, 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

Hope I have understood your requirement correctly but code can be adjusted if needed

Hope Helpful

Dave

 

[W R]

Hi,

try following update to your code & see if does what you want

Sub CopyData()
    Dim ws1         As Worksheet, ws2 As Worksheet
    Dim m           As Variant, checkdate As Variant
    Dim RecordRow   As Long
    Dim Response    As VbMsgBoxResult
    '
    ' CopyData Macro
    '
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
   
    'check for date in cell
    checkdate = ws1.Range("F2").Value
   
    RecordRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
   
    If IsDate(checkdate) Then
        'check for matching date in range
        m = Application.Match(CLng(checkdate), ws2.Columns(1), 0)
       
        'inform user
        If Not IsError(m) Then
            Response = MsgBox("Date Exists  Do You Want To Overwrite the Data?", 291, "Date Exists")
            If Response = vbCancel Then Exit Sub Else If Response = vbYes Then RecordRow = CLng(m)
        End If
    End If
   
    'copy range
    ws1.Range("C21:L21").Copy
    ws2.Cells(RecordRow, 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

Hope I have understood your requirement correctly but code can be adjusted if needed

Hope Helpful

Dave

Hi Dave,

Spot on! Thank you!!

Very Much appreciated!

 

[dmt32]

Hi Dave,

Spot on! Thank you!!

Very Much appreciated!

Most welcome glad update does what you want
Many thanks for feedback - very much appreciated

Dave

 

[W R]

Most welcome glad update does what you want
Many thanks for feedback - very much appreciated

Dave

Hi Dave/All,

Not sure if it will be possible, but rather than taking the date from Cell F2 as part of the CheckDate. Would it be possible to have a box pop up requesting the user enter the current date (that will then be placed in to Sheet 1 Cell F2 before the date check is undertaken later in the sub?)

So to summarise this pop up would be the first thing that happens in the sub. Basically, the date in the Cell at the moment is populated by today(), this is fine if the sub is run on the correct day but if this is not run on the same day that the data refers to then you get the wrong date copied to the next sheet. This way it will always have the correct date to which the data corresponds.

Let me know if it needs clarification.

 

[dmt32]

Hi,
If you just want to ensure code is run with todays date then probably may not need an InputBox

After the IsDate line of code try adding line of code shown in BOLD & see if this helps you

If IsDate(checkdate) Then
    
        If DateValue(checkdate) <> Date Then checkdate = Date

Dave

 

[W R]

Hi Dave,

Thanks, so ordinarily I would would it run with today's date but there is a chance that it doesn't get run on the correct day. e.g. it gets run at 7am on Tuesday instead of 6pm on Monday. If I leave it as it is (or with your idea) then if it is run on Tuesday then when it is transferred; Monday's data will have Tuesday's date. If you get what I am saying. It's not essential that we have an input box but if I can then it'll prevent this occurance.

Thanks