Help with For/If/Msgbox

W R

New Member
Joined
Jan 13, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
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);
VBA Code:
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.
 

Some videos you may like

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,018
Office Version
  1. 2016
Platform
  1. Windows
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

New Member
Joined
Jan 13, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Nov 26, 2020
Messages
1,018
Office Version
  1. 2016
Platform
  1. Windows
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?
 
Last edited:

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,485
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Hi,

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

VBA Code:
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
 
Solution

W R

New Member
Joined
Jan 13, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Hi,

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

VBA Code:
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

Well-known Member
Joined
Jul 3, 2012
Messages
6,485
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

New Member
Joined
Jan 13, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Jul 3, 2012
Messages
6,485
Office Version
  1. 2019
Platform
  1. Windows
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



Rich (BB code):
If IsDate(checkdate) Then
    
        If DateValue(checkdate) <> Date Then checkdate = Date

Dave
 

W R

New Member
Joined
Jan 13, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,738
Messages
5,626,606
Members
416,194
Latest member
Dhisilva_aguiar

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