Only update changed cells in variable range triggered by Worksheet_Change

nl05369

New Member
Joined
May 11, 2007
Messages
21
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?
 
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 ...
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Glad we could help & thanks for the feedback
 
Upvote 0
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
 
Upvote 0
You'll need to modify it like
Code:
      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
 
Upvote 0
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):

Code:
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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,824
Messages
6,181,187
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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
Back
Top