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!

 

[johnnyL]

Glad to help.

 

[Rnkhch]

Hi again Happy Friday!

Some of my students just told me that they noticed they cannot paste anything that is larger than 1 cell into the ranges that are controlled by the code. But any 1 cell can be pasted. If the copied range is more than 1 cell, upon pasting, the pasted cells clear themselves to blank automatically.

Any chance you can do something about this? I hope it won't be too complicated. Thank you so much

 

[johnnyL]

Dear Flies at a picnic,
The following should allow you to copy/paste:

Private Sub Worksheet_Change(ByVal Target As Range)
'
   Dim UndoString As String
    
    Dim SelectionRow            As Long
    Dim EndDragColumnLetter     As String, StartDragColumnLetter    As String
    Dim TargetAddressArray      As Variant
'
    If Target.CountLarge < 2 Then Exit Sub                                                      ' If only 1 cell has been selected by user, allow the change
    If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub                           ' Allow deletetions via the delete key
'
    SelectionRow = Selection.Row                                                                ' Save the Selection.Row into SelectionRow
'
    TargetAddressArray = Split(Selection.Address(0, 0), ":")                                    ' Separate Address Range into TargetAddressArray
'
    EndDragColumnLetter = Evaluate(Replace("=LEFT(""X"",MIN(FIND({0,1,2,3,4,5,6,7,8,9}" & _
            ",ASC(""X"")&1234567890))-1)", "X", TargetAddressArray(1)))                         ' Get EndDragColumnLetter of TargetAddressArray(1)
'
    StartDragColumnLetter = Evaluate(Replace("=LEFT(""X"",MIN(FIND({0,1,2,3,4,5,6,7,8,9}" & _
            ",ASC(""X"")&1234567890))-1)", "X", TargetAddressArray(0)))                         ' Get StartDragColumnLetter of TargetAddressArray(0)
'
    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    '   If change was made to ranges we are monitoring then ...
'
        With Application
            .EnableEvents = False                                                               '       Turn Events off to prevent potential code loop
'
            If .CommandBars("Standard").Controls("&Undo").List(1) = "Paste" And _
                    .CutCopyMode = xlCopy Then                                                  '       If Copy/paste detected then ...
                .Undo                                                                           '           Undo the change that was made by the user
'
                Target.PasteSpecial Paste:=xlPasteValues                                        '           Do the Copy/paste as pastespecial PasteValues
                .CutCopyMode = False                                                            '           Clear the clipboard & 'Marching Ants'
                .EnableEvents = True                                                            '           Turn Events back on
                Exit Sub
            End If
'
            .Undo                                                                               '       Undo the change that was made by the user
'
            If SelectionRow = ActiveCell.Row Then                                               '       If Dragging down then ...
                Range(TargetAddressArray(0) & ":" & EndDragColumnLetter & _
                        ActiveCell.Row).AutoFill Destination:=Range(TargetAddressArray(0) & _
                        ":" & TargetAddressArray(1)), Type:=xlFillValues                        '           Make the user changes without affecting format
            Else                                                                                '       Else ...
                Range(StartDragColumnLetter & ActiveCell.Row & ":" & EndDragColumnLetter & _
                        ActiveCell.Row).AutoFill Destination:=Range(TargetAddressArray(1) & _
                        ":" & TargetAddressArray(0)), Type:=xlFillValues                        '           Make the user changes without affecting format
            End If
'
            .EnableEvents = True                                                                '       Turn Events back on
        End With
    End If
End Sub

 

[Rnkhch]

Thank you lol This is fabulous, but I think I found one tiny bug, and hopefully after you fix it, there should be no flies at least for some time lol

Here's the bug. If I drag down or up just one cell, the formatting carries over, but if I drag more than one cell, then it works perfectly.

Thanks again!

 

[johnnyL]

Ok, I am getting tired of swatting all of these flies, so I decided to redo the code a lil bit.

This code should address every problem you have mentioned in this thread, thus far

Let us know how it went after you test the following:

Private Sub Worksheet_Change(ByVal Target As Range)
'
   Dim UndoString As String
    
    Dim SelectionRow            As Long
    Dim EndDragColumnLetter     As String, StartDragColumnLetter    As String
    Dim SelectionAddressArray   As Variant
'
'-----------------------------------------------------------------------------------------------
'
    If Intersect(Target, Range("E3:E42")) Is Nothing And _
            Intersect(Target, Range("F3:F42")) Is Nothing And _
            Intersect(Target, Range("G3:G42")) Is Nothing Then Exit Sub                         ' If change is not in our monitored range, Exit Sub
'
'-----------------------------------------------------------------------------------------------
'
    With Selection
        If .Count = 1 And Application.CutCopyMode = False Then                                  '   If only 1 cell has been changed by user and
'                                                                                               '           not Cut/Copy then ...
            Exit Sub                                                                            '       allow the change & Exit the Sub
        ElseIf .Count = 1 And Application.CutCopyMode = xlCopy Then                             '   ElseIf only 1 cell has been changed by user and
'                                                                                               '       Copy then ...
            With Application
                .EnableEvents = False                                                           '           Turn Events off to prevent potential code loop
                .Undo                                                                           '           Undo the change that was made by the user
'
                Target.PasteSpecial Paste:=xlPasteValues                                        '           Do the Copy/paste as pastespecial PasteValues
                .CutCopyMode = False                                                            '           Clear the clipboard & 'Marching Ants'
                .EnableEvents = True                                                            '           Turn Events back on
                Exit Sub                                                                        '           Exit the sub
            End With
        End If
'
'-----------------------------------------------------------------------------------------------
'
        If .Count > 1 Then                                                                      '   If  more than one cell is being changed then
            With Application
                If .CommandBars("Standard").Controls("&Undo").List(1) <> "Auto Fill" And _
                        .WorksheetFunction.CountA(Target) = 0 Then Exit Sub                     '           Allow deletetions via the delete key
'
                .EnableEvents = False                                                           '           Turn Events off to prevent potential code loop
'
''Debug.Print Application.CommandBars("Standard").Controls("&Undo").List(1)                       ' (1) = "Auto Fill" or "Paste"
                If .CommandBars("Standard").Controls("&Undo").List(1) = "Paste" And _
                        .CutCopyMode = xlCopy Then                                              '           If Copy/paste detected then ...
                    .Undo                                                                       '               Undo the change that was made by the user
'
                    Target.PasteSpecial Paste:=xlPasteValues                                    '               Do the Copy/paste as pastespecial PasteValues
                    .CutCopyMode = False                                                        '               Clear the clipboard & 'Marching Ants'
                    .EnableEvents = True                                                        '               Turn Events back on
                    Exit Sub                                                                    '               Exit Sub
                End If
'
'-----------------------------------------------------------------------------------------------
'
                SelectionRow = Selection.Row                                                    '           Save the Selection.Row into SelectionRow
'
                SelectionAddressArray = Split(Selection.Address(0, 0), ":")                     '           Separate Address Range into
'                                                                                               '                   SelectionAddressArray
                EndDragColumnLetter = Evaluate(Replace("=LEFT(""X"",MIN(FIND({0,1,2,3,4,5,6,7,8,9}" & _
                        ",ASC(""X"")&1234567890))-1)", "X", SelectionAddressArray(1)))          '           Get EndDragColumnLetter of
'                                                                                               '                   SelectionAddressArray(1)
                StartDragColumnLetter = Evaluate(Replace("=LEFT(""X"",MIN(FIND({0,1,2,3,4,5,6,7,8,9}" & _
                        ",ASC(""X"")&1234567890))-1)", "X", SelectionAddressArray(0)))          '           Get StartDragColumnLetter of
'                                                                                               '                   SelectionAddressArray(0)
                .Undo                                                                           '           Undo the change that was made by the user
'
                If SelectionRow = ActiveCell.Row Then                                           '           If Dragging down then ...
                    Range(SelectionAddressArray(0) & ":" & EndDragColumnLetter & _
                            ActiveCell.Row).AutoFill Destination:=Range(SelectionAddressArray(0) & _
                            ":" & SelectionAddressArray(1)), Type:=xlFillValues                 '               Make the user changes without affecting format
                Else                                                                            '           Else ...
                    Range(StartDragColumnLetter & ActiveCell.Row & ":" & EndDragColumnLetter & _
                            ActiveCell.Row).AutoFill Destination:=Range(SelectionAddressArray(1) & _
                            ":" & SelectionAddressArray(0)), Type:=xlFillValues                 '               Make the user changes without affecting format
                End If
'
                .EnableEvents = True                                                            '           Turn Events back on
            End With
        End If
    End With
End Sub

 

[Rnkhch]

Amazing!!! It's working really well. I noticed one little thing which may not be a bug, and it might be just about how to do it correctly. In the previous code, I was able to apply the code to an additional small range i.e., M17:M36 (which happen to consist of three merged cells in each row), away from the main range (E3:G42), just by adding another line under the lines that you wrote, like this:

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 Or _
Not Intersect(Target, Range("M17:M36")) Is Nothing And Target.CountLarge > 1 Then

Now, in the new code when I try to do a similar thing, it doesn't work, and it gives an error:

If Intersect(Target, Range("E3:E42")) Is Nothing And _
Intersect(Target, Range("F3:F42")) Is Nothing And _
Intersect(Target, Range("G3:G42")) Is Nothing And _
Intersect(Target, Range("M17:M36")) Is Nothing Then Exit Sub

With this code, if I make any changes in M17:M36, I get runtime error 1004 which shoots me to the following highlighted lines in the editor:

Range(StartDragColumnLetter & ActiveCell.Row & ":" & EndDragColumnLetter & _
ActiveCell.Row).AutoFill Destination:=Range(SelectionAddressArray(1) & _
":" & SelectionAddressArray(0)), Type:=xlFillValues


That's the only thing I observed so far. Otherwise, it's fabulous.

 

[Rnkhch]

So in other words, what should I do if I ever want to apply the code to additional ranges?

 

[johnnyL]

Merging cells can be a thorn in VBA code's side.

If it was working previously, I guess you can upload the workbook you are currently having issues with, provide the link to it here, and we can take a look at it.

 

[Rnkhch]

Seems like you're right, that the cause of this error is merging the cells. I just set the last line of that code section to M5:M6 which are not merged cells, and it worked really well. I guess I'm gonna have to forget about M17:M36 It would have been nice if this range also worked, but it's not as important a range as the main one.

I'll let you know if I encounter anything else, and I'm gonna set the solution to post 55 which has your latest code.

I can still upload some watered down version of my file if you think you can do some trick, but it's gonna take some time to make it.

Thanks a lot!

 

[johnnyL]

It won't hurt to post a 'watered down version' of your file, as long as we can duplicate the issue you are having. It doesn't even have to be a large sample, as long as we can duplicate your issue, it is fine.