• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Excel Log: VBA to Add Row(s) Upon Workbook Open Last through Current Date

jdppep

Member
I have a log which several of my staff enter information into daily. They generally work Monday through Friday; however, sometimes work weekends. Therefore, I need the log to be inclusive of all dates from log's origin forward (9/21/12-current).

I am struggling to create a VBA code which would add new row(s) to the top of the log from the last date entered to today's current date, maintaining all formatting then adding the date to the appropriate cell. I need the workbook to update automatically when opened as these users are inexperienced with excel.

The column headers are in rows 1-3. The dates are in column B and begin in cell B4. The data within the table begins in cell C4.

Any help is greatly appreciated. Thank you!
 
Put this in the ThisWorkbook module and modify to suit. I interpreted your request as needing the dates in descending order, with today's date at the top.
Code:
Private Sub Workbook_Open()
Dim myDate As Date
Dim numRows As Long
Dim oldDate As Date
 
'Which worksheet are we dealing with?
Worksheets("Sheet1").Select
 
'Setup our variables
myDate = Date
oldDate = Range("B4").Value
numRows = DateDiff("d", oldDate, myDate)
 
If numRows <= 0 Then Exit Sub 'No need to do anything
 
Application.ScreenUpdating = False
Range("4:4").Copy
 
'Can't use a With statement since rows are moving
'Insert # of needed rows
Range("4:" & 4 + numRows - 1).Insert shift:=xlDown
'Clear copy data
Range("4:" & 4 + numRows - 1).ClearContents
 
'Fill in the dates
With Range("B4:B" & 4 + numRows - 1)
    .FormulaR1C1 = "=R[1]C+1"
    .Value = .Value
End With
Application.ScreenUpdating = True
End Sub
 
Luke, thanks for this. Unfortunately, it did not work. I received a Run-time error '9': subscript out of range.
 
Hi, jdppep!
Could you check if you have a worksheet named Sheet1 in your workbook? If so, consider uploading a sample file (including manual examples of desired output if applicable), it'd be very useful for those who read this and might be able to help you. Thank you.
Regards!
 
Please see the attached example. I appreciate the help!
 

Attachments

  • ROI Processing Log_Example.xlsx
    88.9 KB · Views: 4
Hi ,

Did you go through the post by SirJB7 ?

Luke's macro has the following statement :

Worksheets("Sheet1").Select

Replace the text Sheet1 by the name of your worksheet i.e. ProcessingLog , so that the above statement becomes :

Worksheets("ProcessingLog").Select

Narayan
 
This works! Is there a way to use this same code with a protected sheet which is also part of a shared workbook?
 
At the begining of the code, after you select the worksheet, add this line:
Code:
ActiveSheet.Unprotect "mypassword"

and at the end
Code:
ActiveSheet.Protect "mypassword"

If there is not password, you can just delete that part.
 
I received the following error: "Compile Error in Hidden Module: ThisWorkbook. This error commonly occurs when code is incompatible with the version, platform, or architecture of this application."
 
Post #5 has a sample file. I was able to get this to work on a protected document; however, it does not work when the document allows shared editing. I now receive a message "Run-time error '1004': Unprotected method of Worksheet Class failed. My complete code is as follows:

Private Sub Workbook_Open()
Dim myDate As Date
Dim numRows As Long
Dim oldDate As Date

'Which worksheet are we dealing with?
Worksheets("ProcessingLog").Select

ActiveSheet.Unprotect "mypassword"

'Setup our variables
myDate = Date
oldDate = Range("B4").Value
numRows = DateDiff("d", oldDate, myDate)

If numRows <= 0 Then Exit Sub 'No need to do anything

Application.ScreenUpdating = False
Range("4:4").Copy

'Can't use a With statement since rows are moving
'Insert # of needed rows
Range("4:" & 4 + numRows - 1).Insert shift:=xlDown
'Clear copy data
Range("4:" & 4 + numRows - 1).ClearContents

'Fill in the dates
With Range("B4:B" & 4 + numRows - 1)
.FormulaR1C1 = "=R[1]C+1"
.Value = .Value
End With
Application.ScreenUpdating = True

ActiveSheet.Protect "mypassword"

End Sub
 
Hi SirJB7, thanks for the link. It appears what I am trying to do should work. This code is working for me now:

Private Sub Workbook_Open()
Dim myDate As Date
Dim numRows As Long
Dim oldDate As Date

'Which worksheet are we dealing with?
Worksheets("ProcessingLog").Select

' switch off workbook sharing

Application.DisplayAlerts = False
ActiveWorkbook.ExclusiveAccess
Application.DisplayAlerts = True

' use feature not allowed in shared workbook
' etc...

ActiveSheet.Unprotect "mypassord"

'Setup our variables
myDate = Date
oldDate = Range("B4").Value
numRows = DateDiff("d", oldDate, myDate)

If numRows <= 0 Then Exit Sub 'No need to do anything

Application.ScreenUpdating = False
Range("4:4").Copy

'Can't use a With statement since rows are moving
'Insert # of needed rows
Range("4:" & 4 + numRows - 1).Insert shift:=xlDown
'Clear copy data
Range("4:" & 4 + numRows - 1).ClearContents

'Fill in the dates
With Range("B4:B" & 4 + numRows - 1)
.FormulaR1C1 = "=R[1]C+1"
.Value = .Value
End With
Application.ScreenUpdating = True

ActiveSheet.Protect "mypassword"

' make workbook shared again

Application.DisplayAlerts = False
ActiveWorkbook.KeepChangeHistory = True
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, AccessMode:=xlShared
Application.DisplayAlerts = True

End Sub
I still need to try with multiple users open consecutively. If I remove the sharing, the code creates an error; however, as soon as the protection and sharing are re-applied it works.
Thanks for all the help. I will let you know what I find with regards to multiple users accessing!
 
Hi, jdppep!

I'm afraid I'm bad news. Have you checked the 13th (bad luck? nahhh...) entry of the linked article?
"In a shared workbook, you cannot:Protect or unprotect worksheets or the workbook
However, this functionality is available: You can use existing protection"

That's to say, protected as you open it, you can use it; but not even think of changing that.

So you can't run the macro on a shared open file. Unless someone proves me wrong (which I wish since I don't know a workaround for this issue).

Glad to help you and welcome back whenever needed or wanted.

Regards!
 
Back
Top