Shortening code, need help.

[xancalagonx]

Fairly new to VBA coding, but loving it and it's really making life easier (at work at least).

I've made some rather simple code in a worksheet where I am using VBA to add Date and Application.Username to two columns whenever someone changes the information in 3 other columns.

This is the code I am using.

Private Sub Worksheet_Change(ByVal Target As Range)
 
If Not Intersect(Target, Range("c2:c1000")) Is Nothing Then
       With Target(1, 5)
            .Value = Date
            .EntireColumn.AutoFit
            .Locked = True
        End With
        With Target(1, 6)
            .Value = Application.UserName
            .EntireColumn.AutoFit
            .Locked = True
        End With
ActiveSheet.Protect Password:="", userinterfaceonly:=True
End If
If Not Intersect(Target, Range("d2:d1000")) Is Nothing Then
    With Target(1, 4)
        .Value = Date
        .EntireColumn.AutoFit
        .Locked = True
    End With
    With Target(1, 5)
        .Value = Application.UserName
        .EntireColumn.AutoFit
        .Locked = True
    End With
ActiveSheet.Protect Password:="", userinterfaceonly:=True
End If
If Not Intersect(Target, Range("e2:e1000")) Is Nothing Then
    With Target(1, 3)
        .Value = Date
        .EntireColumn.AutoFit
        .Locked = True
    End With
    With Target(1, 4)
        .Value = Application.UserName
        .EntireColumn.AutoFit
        .Locked = True
    End With
ActiveSheet.Protect Password:="", userinterfaceonly:=True
End If
End Sub

What I want is to use just 1 chunk of code to handle all three variables for the Ranges (column C, D and E), and the variables using Target from (1,3 to 1,6).

Since the Target changes depending on what column the user does a change in I ended up making 3 "copy/paste" pieces of code.

I was thinking maybe using Arrays I could break this code down to just one chunk of code, then have the variables instead of the Range and Target values?

Hope I explained it properly. I never used Arrays or multiple ranges before... at least not in same line of code so to speak.

The code works as it should right now, but now that it DOES work, I want to refine it

I was thinking something along the lines of using only this chunk of code, and then having the parts I bolded to change.

If Not Intersect(Target, Range("c2:c1000")) Is Nothing Then
       With Target(1, 5)
            .Value = Date
            .EntireColumn.AutoFit
            .Locked = True
        End With
        With Target(1, 6)
            .Value = Application.UserName
            .EntireColumn.AutoFit
            .Locked = True
        End With
ActiveSheet.Protect Password:="", userinterfaceonly:=True
End If

Hope someone can help as this would broaden my VBA knowledge alot as well.

 

[mikerickson]

How about

If Not Intersect(Target, Range("c2:e1000")) Is Nothing Then
       With Target.EntireRow.Cells(1,8)
            .Value = Date
            .EntireColumn.AutoFit
            .Locked = True
        End With
        With Target.EntireRow.Cells(1, 9)
            .Value = Application.UserName
            .EntireColumn.AutoFit
            .Locked = True
        End With
        ActiveSheet.Protect Password:="", userinterfaceonly:=True
End If

 

[xancalagonx]

Will that place the Date and Application.Username in column G and H, respectively, nomatter which column (C, D or E) the user is changing data?

E.g. if he's changing cell C15, and then changes E15... both will place the Date and Application.Username into the correct cells in column G and H?

My problem was how the "distance" from the active cell changes when you jump between the columns, and then it would add the Date in entirely wrong cells

And yeah, I could define it and tell it to go to column G or H specifically, but I wanted the code to be more flexible.

Hm, I added your code to my excel sheet, and assigned column I, J, K for testing Range("I2:K1000") rather than C to E.. but when I changed value in one of the columns my excel crashed

 

[Rick Rothstein]

Not sure about when you are unlocking the sheet, but for the code you posted, I think this will duplicate its functionality...

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Columns("C:E")) Is Nothing Then
    Cells(Target.Row, "F").Value = Date
    Columns("F").AutoFit
    Cells(Target.Row, "G").Value = Application.UserName
    Cells(Target.Row, "F").Resize(, 2).Locked = True
    ActiveSheet.Protect Password:="", UserInterfaceOnly:=True
  End If
End Sub

 

[xancalagonx]

I never unprotect the sheet. The idea is that the columns with date and username will never be accessed by the user. That's why I use "UserInterfaceOnly:=True" which allows the macro to edit those columns, but you can't edit it by "manually" clicking and typing into it.

This way I can always see last date a row was modified, and by whom.

As for the suggestion, I can use it the way you are right now by assigning the columns individually. I was thinking maybe there was a neat way to do it using Target.

Maybe I'm overcomplicating it though...

 

[Rick Rothstein]

Ahh, I think I see what you are after. Give this event code a try...

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Columns("C:E")) Is Nothing Then
    With Target.Offset(, 6 - Target.Column)
      .Value = Date
      .EntireColumn.AutoFit
      .Offset(, 1).Value = Application.UserName
      .Resize(, 2).Locked = True
    End With
    ActiveSheet.Protect Password:="", UserInterfaceOnly:=True
  End If
End Sub

 

[mikerickson]

Will that place the Date and Application.Username in column G and H, respectively, nomatter which column (C, D or E) the user is changing data?
...
My problem was how the "distance" from the active cell changes when you jump between the columns, and then it would add the Date in entirely wrong cells

Yes that was the goal of my code.
Using the .EntireRow property makes the column of Target irrellivant.

 

[xancalagonx]

Yes that was the goal of my code.
Using the .EntireRow property makes the column of Target irrellivant.

Hm, I tried adding yours, and changed the range from c2:e1000 to i2:k1000 (so I could test it without having to disable the rest of the code in same worksheet).

But then my excel sheet "blew up" and I had to exit it

 

[xancalagonx]

Ahh, I think I see what you are after. Give this event code a try...

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Columns("C:E")) Is Nothing Then
    With Target.Offset(, 6 - Target.Column)
      .Value = Date
      .EntireColumn.AutoFit
      .Offset(, 1).Value = Application.UserName
      .Resize(, 2).Locked = True
    End With
    ActiveSheet.Protect Password:="", UserInterfaceOnly:=True
  End If
End Sub

This worked perfectly., only had to adjust (, 6 - Target.column) to be (, 7 - Target.column)

Question though, what exactly is it doing in that statement?

If I'm changing content of C15... it tells it to go 7 cells to right (to column I, then - target.column would be (in this case), 3 back again to G?

Just trying to understand exactly how it's working and the logic behind it

Oh, I found a slight 'bug' though.

If I select two adjacent cells at once (e.g. C15 and D15), then change the content of them at same time (delete the content for instance), then it will add the username in both column H (as it should) but also in column I ... hmm...

 

[Rick Rothstein]

This worked perfectly., only had to adjust (, 6 - Target.column) to be (, 7 - Target.column)

Question though, what exactly is it doing in that statement?

If I'm changing content of C15... it tells it to go 7 cells to right (to column I, then - target.column would be (in this case), 3 back again to G?

Just trying to understand exactly how it's working and the logic behind it

The Offset property (of which the "7-Target.Column" is an argument for) moves the reference from the cell it is attached to down (not in this case, though, hence the lack of anything in front of the comma) and over (which is the case here) the number of rows/columns specified. Hence, for the columns that you are interested in, we need the difference between Column G (where the date goes) and the Target's column, hence we simply subtract the column numbers from each other... that gives us the number of columns we need to move over from the Target cell to get to Column G.

Oh, I found a slight 'bug' though.

If I select two adjacent cells at once (e.g. C15 and D15), then change the content of them at same time (delete the content for instance), then it will add the username in both column H (as it should) but also in column I ... hmm...

See if this modification to my code works better for you...

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Cell As Range
  If Not Intersect(Target, Columns("C:E")) Is Nothing Then
    For Each Cell In Intersect(Target, Columns("C:E"))
      With Cell.Offset(, 7 - Cell.Column)
        .Value = Date
        .EntireColumn.AutoFit
        .Offset(, 1).Value = Application.UserName
        .Resize(, 2).Locked = True
      End With
    Next
    ActiveSheet.Protect Password:="", UserInterfaceOnly:=True
  End If
End Sub