Hello,
I know this problem has been discussed at length before and I've never seen a workaround - at least none that I can remember.
I've been working on this problem for years and last summer I came across a couple of key bits of information.
I been able get a working solution - but it is limited to SINGLE row selected.
I feel pretty confident that what I want to do can be done, but I'm not savvy enough to get it working fully.
The entire concept rests on a Two Key functions:
1> the Insert Rows function leaves the Ranges in the "applies to" part of a conditional format intact by expanding the range!The inserted rows must be blank - can't be copied
2> using VBA to "paste special Paste:=xlPasteFormats" does NOT include the conditional formatting.
This is the OPPOSITE of paste special "formats" and "Copy & insert copied cells" when done from the user interface.
Macro workflow:
User makes selection of rows (could be full rows or just within a set of columns - this is key if the worksheet is locked because full rows can't be selected).
User runs Macro(Not present in current macro, but it should check that the selection set is a contiguous set of rows)
Macro creates a selection that = the entire rows of the selected cells.
IF Selection is 'nothing'Count the number of rows
Use normal 'insert rows' and insert the same number of rows as the user selected
ElseCount the number of rows
Define the entire rows of the user selection as a range to reference, and return to
Insert the same number of rows as the user selection
Use a loop to check every cell of the user range and then copy
There are two steps to the copy function:
If Formula - then copy the formula
Always copy the formats
Final step is to return the user to the original selection or the rows of the original selection which allows the user to run the Macro again on the same set of data
Sub Macro_Insert_Row_test5() ' Insert_And_Copy Macro - keep conditional formatting ranges intact.
Dim PrevRow As Range
Dim CurrentRow As Range
Dim NextRow As Range
Dim FirstRow As Long
Dim LastRow As Long
Dim TotalRows As Long
Set CurrentRow = Selection.EntireRow ' Create the data set to be copied
FirstRow = Selection.Row ' First row of user selected data
LastRow = Selection.Row + Selection.Rows.Count - 1 ' Last row of user selected data
TotalRows = LastRow - FirstRow + 1 ' Total number of rows in User Selected data
Set ValueTest = ActiveSheet.UsedRange ' Debugging value to follow the 'is nothing' comparator
Application.ScreenUpdating = False ' keep screen update clean and speed up code
Application.CutCopyMode = False ' keep the clipboard free of large data sets - usefulness un-confirmed
If Intersect(ActiveSheet.UsedRange, Selection.Offset(1, 0).EntireRow) Is Nothing Then ' If the selection is blank, copy and insert as normal
Selection.EntireRow.Insert Shift:=xlDown
MsgBox "I copied a blank row" 'for testing - commented out in normal use
Else
If TotalRows > 1 Then ' If Selection.Rows.Count Greater than 1 row Then
MsgBox "More than one row selected." & vbCrLf & FirstRow & " " & LastRow & " " & TotalRows ' Report the coniditon to user - this would be skipped in final code
Rows(FirstRow & ":" & LastRow).Offset(TotalRows).Insert Shift:=xlDown ' insert the same number of rows as the selection
' need help here
Else ' If only a single row - continue with code below
Set PrevRow = ActiveCell.EntireRow ' Set Variable
PrevRow.Offset(1, 0).EntireRow.Insert ' Insert BELOW the row
For Each Cell In Intersect(ActiveSheet.UsedRange, Selection.EntireRow)
Cell.Copy ' Copy current active cell contents
If Cell.HasFormula Then ' Check for formula
Cell.Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas ' ONLY paste formula if yes
MsgBox "I copied formula" ' for testing - commented out in normal use
End If
Cell.Offset(1, 0).PasteSpecial Paste:=xlPasteFormats ' Paste formats - testing indicates that this excludes conditonal formatting
Next Cell
End If
End If
CurrentRow.Select ' Set the current row to use command again
End Sub
You will notice that there is an additional check in the actual code, and that is to check if there is more than 1 row selected, this is because I couldn't figure out to get the copy.cell code to work when there needed to be an offset.
I assume that in the final code, I would not need this code because the structure wouldn't care how many rows were selected.
The first check (If nothing) is purely to keep things moving faster if the cells are blank.
I hope that this not hard to solve, and it would just take someone who knows how to write the syntax to copy a cell and then paste it down by the right number of rows.
Thanks for your help!
This macro really keeps things clean when conditional formats are used.
Regards,
SEPP!
Bookmarks