Skip to main content

VBA code slowing workbook

I have a spreadsheet with five sheets all of which run the same VBA code; everything was good when it was on just the one sheet, but now its running on all five sheets Excel is extremely slow to load and the items take a while to update.

I have a drop down menu in one column and if a user selects an item from this list it updates the next two cells with their username and date and time stamps it. I have 12 sections on each sheet for each month of the year.

I'm a VBA newbie but I adapted this code from another website with a little trial and error. Is there a way I can speed things up? My code is:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Column = 1 Or Target.Column = 2 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("D" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("C" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("C:D").EntireColumn.AutoFit
    End If
    If Target.Column = 1 Or Target.Column = 5 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("G" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("F" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("F:G").EntireColumn.AutoFit
    End If
    If Target.Column = 1 Or Target.Column = 8 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("J" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("I" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("I:J").EntireColumn.AutoFit
    End If
    If Target.Column = 1 Or Target.Column = 11 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("M" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("L" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("L:M").EntireColumn.AutoFit
    End If
    If Target.Column = 1 Or Target.Column = 14 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("P" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("O" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("O:P").EntireColumn.AutoFit
    End If
    If Target.Column = 1 Or Target.Column = 17 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("S" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("R" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("R:S").EntireColumn.AutoFit
    End If
    If Target.Column = 1 Or Target.Column = 20 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("V" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("U" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("U:V").EntireColumn.AutoFit
    End If
    If Target.Column = 1 Or Target.Column = 23 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("Y" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("X" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("X:Y").EntireColumn.AutoFit
    End If
    If Target.Column = 1 Or Target.Column = 26 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("AB" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("AA" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("AA:AB").EntireColumn.AutoFit
    End If
    If Target.Column = 1 Or Target.Column = 29 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("AE" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("AD" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("AD:AE").EntireColumn.AutoFit
    End If
    If Target.Column = 1 Or Target.Column = 32 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("AH" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("AG" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("AG:AH").EntireColumn.AutoFit
    End If
    If Target.Column = 1 Or Target.Column = 35 Then
        ThisRow = Target.Row
        If (ThisRow = 1) Then Exit Sub
        ' time stamp corresponding to cell's last update
        Range("AK" & ThisRow).Value = Now
        ' Windows level UserName | Application level UserName
        Range("AJ" & ThisRow).Value = Environ("username") & "|" & Application.UserName
        Range("AK:AJ").EntireColumn.AutoFit
    End If
End Sub

Thank in advance for any assistance.

Ben
  • 21
  • 1