How to repeat code to apply merged cell formatting to multiple rows?

Question

I'm creating a button that will allow the user to add a new record to the very top of the list, and move all records one row below (to keep the newest records at the top). The code I've written works perfectly as-is. However, I have to write a lot of repeating code to apply it to all rows within the range. Here is my code:

Sub Test2()

    ' Stop screen from following macro actions & disable alerts
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' If more than 1 record, copy all rows and paste 1 row below, apply merged cell formatting, clear data from first row, and re-enable alerts/screen updating
    If WorksheetFunction.CountA(Range("AM5:AN21")) > 1 Then
        Range("CW28:DJ28").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Range("CW29:DJ29").Select
        ActiveSheet.Paste

        Range("CW28:DJ28").Select
        Selection.Copy
        Range("CW29").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False

...

        Range("CW1277").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

        Range("CW28:DJ28").Select
        Selection.ClearContents
        Range("CW28:CX28").Select

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

    ' If only 1 record, copy first row and paste 1 row below, apply merged cell formatting, clear data from first row, and re-enable alerts/screen updating
    ElseIf WorksheetFunction.CountA(Range("AM5:AN21")) = 1 Then
        Range("CW28:DJ28").Select
        Selection.Copy
        Range("CW29:DJ29").Select
        ActiveSheet.Paste

        Range("CW28:DJ28").Select
        Selection.Copy
        Range("CW29").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False

...

        Range("CW1277").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

        Range("CW28:DJ28").Select
        Selection.ClearContents
        Range("CW28:CX28").Select

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

    ' If zero records, re-enable alerts/screen updating
    Else
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    End If

End Sub

As you can see, the two spots where the "..." I need to apply to rows 29 through 1277. I know there's got to be a better way to do this with For ... Next, but what I've tried hasn't worked (code that I used is below, it would give me an error saying I can't do that to merged cells, even though my current code works).

Dim rng As Range: Set rng = Application.Range("CW28:CX1277")
Dim i As Integer
For i = 1 To 1248
    rng.Cells(RowIndex:=i, ColumnIndex:="CW").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Next

I know my entire issue is that we have merged cells, but we need to keep them if at all possible. Knowing that my current, repetitive coding works... is there a way to make the For ... Next function work?

You should read this first https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — SJR, Dec 16 '19 at 15:47
I admit I didn't really read all the code (lots is redundant, see link above) - but why don't you just insert a new row at the top? If your data is in, say `A2:Z100`, you could do `Dim rng as Range // Set rng = Range("A2:Z100") // rng.Rows(1).EntireRow.Insert`? AFAIK that should just push everything down one, keep any merged cells, etc... — BruceWayne, Dec 16 '19 at 15:49
@BruceWayne Thanks for the quick response! Wouldn't that solution insert a row *everywhere*, and not just in the range I need it to? There is data in other columns, so inserting a row across the entire spreadsheet would alter/intrude on other data. I will read up on how to avoid using .Select, thank you for the link! — travelbug928, Dec 16 '19 at 15:58
Then you could do `rng.rows(1).insert`, which would push just that range down. Just tested with `Set rng = Range("A2:D10")` where I had other data in column E. `rng.rows(1).insert` just pushed `A2:D10` down, leaving Column E untouched. — BruceWayne, Dec 16 '19 at 15:59
@BruceWayne That would work! So, this is in a dashboard layout of sorts - leadership team wants this to be printable on an 11x17 sheet, so I have limited space to capture all information they're requesting. Because of this, I have data both to the sides of this range, AND below it... so inserting a row actually won't work in this situation, even though it would make the code far easier. :( That's why I have it copying and pasting below it - because they have a MAX of X records they're going to be inputting, so the box that captures all of those records will always be the same size. — travelbug928, Dec 16 '19 at 16:38
What are you copy/pasting below? If you have data below the range you're trying to insert. ...are you copying the current data, pasting it below the other data that's there, and therefore leaving only the new data where that range is? — BruceWayne, Dec 16 '19 at 16:56
@BruceWayne I took a video of what the code currently does (my apologies for the quality, I didn't have a screen recording app so I just used my phone). See this link: https://drive.google.com/file/d/1YOdKk-LxmaSYfgb_jV0s-UQHrJInumm2/view?usp=sharing — travelbug928, Dec 16 '19 at 18:12

score 0 · Answer 1 · answered Dec 16 '19 at 16:40

0

What I understand of your code is that you copy the format of line N to line N+1 for columns CW to DJ, from lines 28 to 1277, by block. (I strongly suppose it is not as much simple).

What you could do is (I replace your 28 by beginRow) :

  dim beginRow as long, endRow as long
  dim strRange as string
  beginRow=28
  while (beginRow<<1277)
        strRange = "CW" & beginRow & ":DJ" & beginRow
        Range(strRange).select
        endRow=Selection.End(xlDown).row
        strRange = "CW" & beginRow & ":DJ" & endRow
        Range(strRange).Copy
        strRange = "CW" & (beginRow+1) & ":DJ" & (endRow+1)
        Range(strRange).Select
        ActiveSheet.Paste

        strRange = "CW" & (beginRow) & ":DJ" & (beginRow+1)
        Range(strRange).Copy
        Range("CW" & (beginRow+1)).Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False

        ' find next block
        beginRow=Range("CW" & (endRow+1)).End(xlDown).row
   wend

Could this help ? Pierre.

answered Dec 16 '19 at 16:40

Pierre_J44000

11
1

1

It'd be best to [avoid using `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). – BruceWayne Dec 16 '19 at 16:55
@BruceWayne Yes, it's true ; it would go faster I suppose. But during debugging time, it's usefull to see what is done. The variable strRange is not usefull, but step by step you can folow the ranges. – Pierre_J44000 Dec 16 '19 at 17:07
@Pierre_J44000 Thank you so much for this! Unfortunately, it didn't work. It ran through the macro completely and didn't result in any errors, however it's not pasting the Formatting to the cells in that range like it should. – travelbug928 Dec 16 '19 at 19:18
OK, I think that what I had understood of your process was not good. In fact, you only copy the format of the line 28 (CW:DJ) to all the other lines until 1277. Why don't you directly write Range("CW28:DJ28").Copy / Range("CW29:DJ1277").PasteSpecial ... ? I Think it would work the same way. – Pierre_J44000 Dec 17 '19 at 08:29

score 0 · Accepted Answer · answered Dec 16 '19 at 19:47

I figured it out!

Dim rng As Range
Dim cell As Range

    Range("CW28:DJ28").Select
    Selection.Copy

    Set rng = Range("CW29:1277")
    For Each cell In rng.Cells
        cell.Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    Next cell

    Application.CutCopyMode = False

Now, I need to focus on how to get rid of .Select and .Activate throughout my code. Thank you so much for your help, all!

How to repeat code to apply merged cell formatting to multiple rows?

2 Answers2