Is there any way that 'filling' can be restricted to values only and not formatting, perhaps through VBA?

[Rnkhch]

Hello,

I know that it is possible to right-click and drag and then select 'fill without formatting', but is there any formatting changes can be disabled for dragging/filling, perhaps through a VBA code?

Thanks for any input!

 

[Rnkhch]

Thanks much! Just tested in my actual work file, and it's working well there too, so now it's a step improved

If you could also come up with a code to take care of dragging any cell in the same range (i.e. just dragging values and no formatting), please let me know.

 

[johnnyL]

If you could also come up with a code to take care of dragging any cell in the same range (i.e. just dragging values and no formatting), please let me know.

This should get you started, It's not complete, but it will give you a starting point:

Private Sub Worksheet_Change(ByVal Target As Range)
'
    If Not Intersect(Target, Range("E3:E42")) Is Nothing And Target.CountLarge > 1 Then
        With Application
            .EnableEvents = False
            .Undo
            Cells(Target.Row - 1, Target.Column).AutoFill Destination:=Range(Cells(Target.Row - 1, _
                    Target.Column), Cells(Target.Row - 1 + Target.CountLarge, Target.Column)), Type:=xlFillValues
            .EnableEvents = True
        End With
    End If
End Sub

 

[Rnkhch]

OMG, your code is already working well, so as far as my tests showed, it is complete and so magical!!! I tested dragging at various points within the range, and I even dragged upwards, and it worked perfectly well!!!

Thank you!

 

[Rnkhch]

Now just one more question. If I want to apply this code to more than one range in the same sheet, what should I do? Would I copy and paste the code multiple times and change the ranges, or is there a more efficient way?

 

[Rnkhch]

Actually, I take it back; it's not so magical. I realized I cannot delete anything now in the range As soon as delete a piece of the range, the contents of the cells magically reappear, so please help if you can

 

[johnnyL]

Actually, I take it back; it's not so magical. I realized I cannot delete anything now in the range As soon as delete a piece of the range, the contents of the cells magically reappear, so please help if you can

That is why I said it was a start.

You can, however, delete cells, one at a time in the current condition of the code.

 

[johnnyL]

Now just one more question. If I want to apply this code to more than one range in the same sheet, what should I do? Would I copy and paste the code multiple times and change the ranges, or is there a more efficient way?

To do that you could use 'Or's ... for example:

Private Sub Worksheet_Change(ByVal Target As Range)
'
    If Not Intersect(Target, Range("E3:E42")) Is Nothing And Target.CountLarge > 1 Or _
            Not Intersect(Target, Range("F3:F42")) Is Nothing And Target.CountLarge > 1 Or _
            Not Intersect(Target, Range("G3:G42")) Is Nothing And Target.CountLarge > 1 Then
        With Application
            .EnableEvents = False
            .Undo
            Cells(Target.Row - 1, Target.Column).AutoFill Destination:=Range(Cells(Target.Row - 1, _
                    Target.Column), Cells(Target.Row - 1 + Target.CountLarge, Target.Column)), Type:=xlFillValues
            .EnableEvents = True
        End With
    End If
End Sub

 

[Rnkhch]

Thank you. The 'Or's work well when only one cell in one column is dragged. But I tried dragging two cells selected together in columns E and F and it didn't work (only E got expanded but double the number of cells I dragged ).

If you can solve these two issues, i.e. deleting more than once cell at a time and dragging more than one cell at a time, you'll be the absolute genius

 

[johnnyL]

The following should allow the deletions:

Private Sub Worksheet_Change(ByVal Target As Range)
'
    If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub                           ' Check/Allow deletetions
'
    If Not Intersect(Target, Range("E3:E42")) Is Nothing And Target.CountLarge > 1 Or _
            Not Intersect(Target, Range("F3:F42")) Is Nothing And Target.CountLarge > 1 Or _
            Not Intersect(Target, Range("G3:G42")) Is Nothing And Target.CountLarge > 1 Then
        With Application
            .EnableEvents = False
            .Undo
            Cells(Target.Row - 1, Target.Column).AutoFill Destination:=Range(Cells(Target.Row - 1, _
                    Target.Column), Cells(Target.Row - 1 + Target.CountLarge, Target.Column)), Type:=xlFillValues
            .EnableEvents = True
        End With
    End If
End Sub

 

[Rnkhch]

OMG, this is superb!!! Thank you!

One last step left now, for multi-column dragging


If it helps, I just tested three-column drag which resulted in an error, and when I hit debug, these two lines of code were highlighted:

Cells(Target.Row - 1, Target.Column).AutoFill Destination:=Range(Cells(Target.Row - 1, _
Target.Column), Cells(Target.Row - 1 + Target.CountLarge, Target.Column)), Type:=xlFillValues