Only update changed cells in variable range triggered by Worksheet_Change

[nl05369]

Hello,
I have a sheet that user can update.
Columns A, C-G and I-J are text
Columns B and H are date format.

I force the format to consolas (to see difference between O and 0), set the date cells to yyyy-mm-dd, do some centering and indenting.
BUT: I do this inefficiently on all cells from row 2 to row 999 because I cannot figure out how to only manipulate the cells that are changed due to multiple formats being used.

What I use now (that works, but leaves me with far to large workbook on save):

[VBA]Sub Worksheet_Change(ByVal target As Range)
On Error Resume Next

If target.Row = 1 Then Exit Sub

Dim Changed_Cell_Address As String
Dim Cell_Range As Range
Changed_Cell_Address = target.Address

Application.EnableEvents = False

Set Cell_Range = Range(Changed_Cell_Address)

'Clear all cell formatting in updated cells
Cell_Range.ClearFormats

' Set cell format to standard Consolas font 9 for easy differentation of numbers
ActiveSheet.Unprotect
ActiveWorkbook.Unprotect
With Range(Changed_Cell_Address).Font
.Name = "Consolas"
.FontStyle = "Regular"
.Size = 9
End With
Range(Changed_Cell_Address).Locked = False
Range("A2", "A999").IndentLevel = 1
Range("B2", "B999").NumberFormat = "yyyy-mm-dd"
Range("B2", "B999").HorizontalAlignment = xlCenter
Range("G2", "G999").HorizontalAlignment = xlCenter
Range("H2", "H999").HorizontalAlignment = xlCenter
Range("I2", "I999").HorizontalAlignment = xlCenter
Application.Run "ThisWorkbook.ExcelDiet"

ActiveSheet.Protect
ActiveWorkbook.Protect
Application.EnableEvents = True

End Sub[/VBA]


how can I manipulate ONLY the changed cells?

 

[nl05369]

Thanks for the effort James. I really appreciate it.
(Final) solution has been provided by Fluff.
cheers
Alex

As soon as I can get a moment to dig into a test for you ...

I will see if a Loop of each cell in the Target area can fix your problem ... or not ...

By the way would the copy paste process always be blocks of Columns ranging from A to J ... or could it a ' selective ' copy paste without only some columns ...

 

[Fluff]

Glad we could help & thanks for the feedback

 

[nl05369]

okay... I'm still really happy, but as you said, it works if pasting whole rows.
If a user pastes a few cells in the middle, or a mail address in column J, then formatting of course does not work because the ".column(x)" reference is wrong.
Is it possible to force the reference for ".column(1)" to being really column(1) ie "A" so that the formatting will be correctly done over the whole row (every cell of the relevant line).
So even if 5 mail addresses are pasted in 5 rows, the formatting game will be done from column(1) till column(9) for the relevant rows?
Thanks again
Alex

 

[Fluff]

You'll need to modify it like

      If Not Intersect(Target, Columns(1)) Is Nothing Then
         Intersect(Target, Columns(1)).IndentLevel = 1
      End If
      If Not Intersect(Target, Columns(2)) Is Nothing Then
         With Intersect(Target, Columns(2))
            .NumberFormat = "yyyy-mm-dd"
            .HorizontalAlignment = xlCenter
         End With
      End If

And the same thing for the other columns

 

[nl05369]

Perfect! Now it works as I envisioned. Again, thanks Fluff.. I'll take these learnings away to reuse.

The completed code (for future reference incase anyone else looks):

Sub Worksheet_Change(ByVal Target As Range)   
On Error Resume Next
   If Intersect(Target, Range("A:J")) Is Nothing Then Exit Sub
   
   If Application.CountA(Target) = 0 Then Exit Sub
   Application.EnableEvents = False
   Application.ScreenUpdating = False
   ActiveSheet.Unprotect
   ActiveWorkbook.Unprotect
   Application.Calculation = xlCalculationManual
   With Target
      .ClearFormats
      .Locked = False
      With .Font
         .Name = "Consolas"
         .FontStyle = "Regular"
         .Size = 9
      End With
      
      If Not Intersect(Target, Columns(1)) Is Nothing Then
         Intersect(Target, Columns(1)).IndentLevel = 1
         Intersect(Target, Columns(1)).HorizontalAlignment = xlLeft
      End If
      
      If Not Intersect(Target, Columns(2)) Is Nothing Then
         With Intersect(Target, Columns(2))
            .NumberFormat = "yyyy-mm-dd"
            .HorizontalAlignment = xlCenter
         End With
      End If
      
      If Not Intersect(Target, Columns(3)) Is Nothing Then
         With Intersect(Target, Columns(3))
            .HorizontalAlignment = xlLeft
         End With
      End If
      
      If Not Intersect(Target, Columns(4)) Is Nothing Then
         With Intersect(Target, Columns(4))
            .HorizontalAlignment = xlLeft
         End With
      End If
      
      If Not Intersect(Target, Columns(5)) Is Nothing Then
         With Intersect(Target, Columns(5))
            .HorizontalAlignment = xlLeft
         End With
      End If
      
      If Not Intersect(Target, Columns(6)) Is Nothing Then
         With Intersect(Target, Columns(6))
            .HorizontalAlignment = xlLeft
         End With
      End If
      
      If Not Intersect(Target, Columns(7)) Is Nothing Then
         With Intersect(Target, Columns(7))
            .HorizontalAlignment = xlCenter
         End With
      End If
      
      If Not Intersect(Target, Columns(8)) Is Nothing Then
         With Intersect(Target, Columns(8))
            .NumberFormat = "yyyy-mm-dd"
            .HorizontalAlignment = xlCenter
         End With
      End If
      
      If Not Intersect(Target, Columns(9)) Is Nothing Then
         With Intersect(Target, Columns(9))
            .HorizontalAlignment = xlCenter
         End With
      End If
   End With
   
   
   Application.Calculation = xlCalculationAutomatic
   Application.EnableEvents = True
   Application.ScreenUpdating = False
   ActiveSheet.Protect
   ActiveWorkbook.Protect


End Sub

 

[Fluff]

You're welcome