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]

Ok, great, thank you so much! I'll try to make it ready tomorrow at some time, and I'll reply here.

You are absolute number one

 

[Rnkhch]

Good morning,

Here's a very watered down version of my file, which replicates the error 1004 that I saw in my main file. Hopefully you could do a trick Thanks much! (Clicking on the large "I agree" button at the left will let you download the file)

Test-file

 

[johnnyL]

Below is what I have come up with thus far as far as refereeing the battle between Excel Merged cells and VBA code:

Dim RangeSelected   As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
    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                                 ' If change is not in our monitored range then ...
        RangeSelected = Target.Address(0, 0)                                                    '   Save the RangeSelected
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'
    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                        ' If change is not in our monitored range, Exit Sub
'
'-----------------------------------------------------------------------------------------------
'
    Dim AddressCharacter        As Long, EndAddressRow              As Long
    Dim SelectionRow            As Long
    Dim ActiveColumnLetter      As String, LastMergedColumn         As String
    Dim EndDragColumnLetter     As String, StartDragColumnLetter    As String
    Dim SelectionAddressArray   As Variant
'
'-----------------------------------------------------------------------------------------------
'
    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
'
                If .CommandBars("Standard").Controls("&Undo").List(1) = "Paste" And _
                        .CutCopyMode = xlCopy Then                                              '           If Copy/paste detected then ...
'
                    .EnableEvents = False                                                       '               Turn Events off to prevent potential code loop
                    .Undo                                                                       '               Undo the change that was made by the user
'
                    If ActiveCell.MergeCells Then                                               '               If ActiveCell is merged then ...
'
' Copy/Paste to Merged cell range
'
                        SelectionAddressArray = Split(Selection.Address(0, 0), ":")             '               Separate Address Range into SelectionAddressArray
'
                        For AddressCharacter = 1 To Len(SelectionAddressArray(1))               '               Loop through Address to get the row number
                            If IsNumeric(Mid(SelectionAddressArray(1), AddressCharacter, 1)) Then _
                                    EndAddressRow = EndAddressRow & Mid(SelectionAddressArray(1), _
                                    AddressCharacter, 1)                                        '                   If number found, save it to EndAddressRow
                        Next                                                                    '               Loop back
'
                        ActiveColumnLetter = Split(Cells(1, ActiveCell.Column).Address, "$")(1) '               Get ActiveColumnLetter
'
                        With Range(ActiveColumnLetter & Target.Row & ":" & _
                                ActiveColumnLetter & EndAddressRow)
                            If .MergeCells Then .UnMerge                                        '                   Unmerge the range
                        End With
'
                        Range(RangeSelected).Copy                                               '               Copy the initial selected range
                        Range(ActiveColumnLetter & Target.Row & ":" & ActiveColumnLetter & _
                                EndAddressRow).PasteSpecial Paste:=xlPasteValues                '               Paste as pastespecial PasteValues
                        .EnableEvents = True                                                    '                   Turn Events back on
'
                        LastMergedColumn = Left$(SelectionAddressArray(1), _
                                Len(SelectionAddressArray(1)) - Len(CStr(EndAddressRow)))       '               Get LastMergedColumn letter
'
                        For MergeCellCounter = Target.Row To EndAddressRow                      '               Loop through the rows of the target
                            Range(ActiveColumnLetter & MergeCellCounter & ":" & _
                                    LastMergedColumn & MergeCellCounter).Merge                  '                   Merge the Row columns
                        Next                                                                    '               Loop back
'
                        Exit Sub                                                                '               Exit Sub
                    Else                                                                        '           Else ...
'
' Copy/Paste to UnMerged cell range
'
                        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
                End If
'
'-----------------------------------------------------------------------------------------------
'
                SelectionAddressArray = Split(Selection.Address(0, 0), ":")                     '       Separate Address Range into
'                                                                                               '               SelectionAddressArray
                If ActiveCell.MergeCells And .CommandBars("Standard").Controls("&Undo").List(1) _
                        <> "Auto Fill" And .CommandBars("Standard").Controls("&Undo").List(1) _
                        <> "Paste" Then                                                         '       If Merged cell found & we are not dragging
'                                                                                               '               or copying a cell then ...
' Standard write to single merged cell
'
                    EndAddressRow = ActiveCell.Row                                              '           Save EndAddressRow
'
                    If EndAddressRow - Target.Row = 1 Then Exit Sub                             '           Allow a single Merged cell change
'
                ElseIf ActiveCell.MergeCells And .CommandBars("Standard").Controls("&Undo").List(1) _
                        = "Auto Fill" Or ActiveCell.MergeCells And _
                        .CommandBars("Standard").Controls("&Undo").List(1) = "Paste" Then       '       Else if Dragging or pasting to merged cell then ...
'
' Dragging Merged Cell or pasting to merged cell
'
                    .EnableEvents = False                                                       '           Turn Events off to prevent potential code loop
                    .Undo                                                                       '           Undo the change that was made by the user
'
                    Range(SelectionAddressArray(0) & ":" & _
                            SelectionAddressArray(1)).FormulaR1C1 = Selection.Cells(1)          '           Make the user changes without affecting format
                    .EnableEvents = True                                                        '           Turn Events back on
                    Exit Sub                                                                    '           Exit the sub
                End If
'
'-----------------------------------------------------------------------------------------------
'
                SelectionRow = Selection.Row                                                    '           Save the Selection.Row into SelectionRow...24
'
                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 = Split(Cells(1, ActiveCell.Column).Address, "$")(1)    '               Get StartDragColumnLetter
'
                .EnableEvents = False                                                           '           Turn Events off to prevent potential code loop
                .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

That will be your new Sheet code.

Test that out and let me know how it goes. I am sure you will have other requests once you spot the flaws. I think it is almost complete though, hopefully.

 

[Rnkhch]

Hi, thank you! It's great, and I only found a minor bug, which is pasting into M17:M36. It gives error 1004 which goes to this line:

If .MergeCells Then .UnMerge ' Unmerge the range

where Unmerge is "highlighted"

By the way, my actual file is locked at the level of worksheet and workbook (so that the students don't mess with it any further than they already do lol )

Was there anything else that you spotted that I didn't notice (since you mentioned "flaws")? To me it seemed that everything else is working perfectly.

Thank you

 

[Rnkhch]

P.S. Just found one more minor thing. When I tried to do "paste values" in the main range, everything that was pasted cleared itself automatically.

 

[johnnyL]

Please respond with what you are trying to do when you encounter errors.

Example: Where from and where to. Then I can try & track down the issue.

 

[Rnkhch]

I did detailed pasting tests, and here are my observations:

A) regular pasting (control+V) operations that lead to the error 1004:
1) Pasting one or more (vertically selected) cells from anywhere in E3:G42 into M17:M36
2) Pasting one or more cells from anywhere in M17:M36 into M17:M36
3) Pasting one or more (vertically selected) cells from other unlocked cells outside of E3:G42 into M17:M36

In all these instances, it shoots to:

If .MergeCells Then .UnMerge ' Unmerge the range

where Unmerge is "highlighted"



B) 'pasting values' operations that lead to automatic clearing of pasted cells:
1) pasting more than one vertically selected cells from anywhere in E3:G42 into E3:G42
2) pasting more than one vertically selected cells from outside E3:G42 into E3:G42
3) pasting more than one (vertically selected) cells from M17:M36 into E3:G42
4) pasting more than one vertically and horizontally selected cell from E3:G42 into E3:G42
5 )pasting more than one vertically and horizontally selected cell from outside E3:G42 into E3:G42



C) 'pasting values' operations that lead to the error 1004:
1) pasting one cell from M17:M36 into E3:G42
2) pasting more than one horizontally selected cells from anywhere in E3:G42 into E3:G42
3) pasting more than one horizontally selected cells from outside E3:G42 into E3:G42

In all these instances, it shoots to:

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



Now I see how complex this kind of coding can be. Thanks much!

 

[johnnyL]

Thank you for that update @Rnkhch. I anticipated the problems when copy/pasting values from within the 'monitored' ranges.

Are you saying that you experienced issues with copy/pasting from outside the 'monitored' ranges into the 'monitored' ranges? If so, please give example of that scenario.

And Yes, The merged cells scenario complicates things, especially when you throw in not changing the formatting. But I am not scared. I will give it my best.

 

[Rnkhch]

Thank you so much! Yes, when I said "outside", I meant from "outside monitored ranges". For example, I have unlocked cells above the M17:M36 range, and when I select a 2x2 selection of cells from here and paste it anywhere into E3:G42, they automatically clear (this corresponds to item B5 in my post #67). A3, B2, and C3 above are other examples.

 

[johnnyL]

I am on the case!