Automatically copy cond formatting (2000 sp3)

Topic

New Reply

Greetings!

the situation I have is as follows:

One master, with several children files. I copy the data from the children files into my master. “sometimes” the users have caused problems in cells that are formatted using contitional formatting, and/or have formulas.

I would like to automatically copy any contidional formatting and cell formulas that I always have correct in my first row of data (row 2, cols A-Z). Is is possible to do this using a macro? How?

If you need to see the file, I can append an edited file as requested.

thanks,
Brad

Reply | Quote

Replies

Please send an edited version of the file. It will assist in creating a macro, and it will help to see what functions and formating is being used!
Tx

Reply | Quote

All,
Here is an edited version. I put a comment box on the tab CR Log describing the cells that have formulas, conditional formatting or combination of both.

Thanks,
Brad

Reply | Quote

This routine copies all the formatting in Row 2 of the “CR Log” to all active rows below Row 2, and then steps across all active cells in Row 2. If it finds a formula, it copies it down from row 2 to the end of the used range, otherwise it ignores the cell and moves to the next…

I am not sure if the “With ws” and “End With” construct is useful – I was not sure if this will be invoked from another worksheet – but I don’t think it will hurt anything.

Sub CopyFormats()
'  Copies Formats and Formulas from row 2 of "CR Log" (known to be good)
'  to all active rows of that workbook tab.  Formats include conditional
'  formatting, Formulas include validity tests and results

Dim iLastRow        As Integer
Dim i               As Integer
Dim ws              As Worksheet

Set ws = Sheet2
iLastRow = ws.UsedRange.Rows.Count

Application.ScreenUpdating = False
ws.Activate
With ws
    ' copy formatting only
    .Rows("2:2").Copy
    .Rows("2:" & iLastRow).PasteSpecial Paste:=xlFormats, Operation:=xlNone, _
                                        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ' step through columns and copy formulas
    For i = 1 To .UsedRange.Columns.Count
        If .Cells(2, i).HasFormula Then
            .Cells(2, i).Copy
            .Paste Destination:=Range(.Cells(2, i), .Cells(iLastRow, i))
        End If
    Next i
    Application.CutCopyMode = False

    .Cells(2, 2).Select
.Calculate
End With
Set ws = Nothing

Application.ScreenUpdating = True

End Sub

Reply | Quote

Dean,
To confirm, do I make a new module for this code?
Thanks,
Brad

Reply | Quote

Brad – you can either paste it either into a new or an existing module – modules can contain more than one VBA routine. In the file attached to that post it is in a new module.

Reply | Quote

Dean,
I inserted the code, and received the following error:
Runtime error ‘1004’:
PasteSpecial method of range class failed.

Clicked on debug, and this line was yellow:
.Rows(“2:” & iLastRow).PasteSpecial Paste:=xlFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Thanks,
Brad

Reply | Quote

If you go to immediate window (trl-g) what do you get when you enter the 2 lines.
? iLastRow

? ws.name

If your spreadsheet gets large you might want to use:
Dim iLastRow As Long

since the 2nd half of the rows are outside the range for integer. (also change the name to lLastRow for consistency.)

Steve

Reply | Quote

Steve,
When I enter the questions, I get :

? lLastRow
1965
? ws.name
CR Log

Where as 1965 is after the last row of data, and the sheet name is CR Log. I still get a failure when I change the information as described.

Any Ideas? It seems to work on the short example but not on the real data.

Brad

Reply | Quote

Hmmm….

I have never run into that – but I get the same thing if I put in a bunch of data that requires the routine to copy down more than ~1650 rows as well. Interestingly, if I tryo to do it manually I get a “Selection Too Large” error – I suspect it is the same problem.

I can think of two approaches:

• step down the list, one row at a time – something like:
  for j = 2 to lLastRow,
  .rows(j:j).pasteSpecial Paste:=xlFormats
  next j
  I think that will be pretty slow, although it could be speeded up by starting at the existing last row of the database range…
  OR
• Since we seem able to paste up to ~1,000 rows at a time, use an index but apply the paste to multiple rows (air code):
  j=0
  do while j < lLastRow/1000
  .rows(j*1000+1:(j+1)*1000).pasteSpecial Paste:=xlFormats
  j = j + 1
  Loop
  – the problem here is that you don’t want to be pasting formulas (although we don’t know if the single-formula pastes will have the same problem) below the true end of data,since that will screw up the database definition, so you will probably want to make the last paste to a number of rows equal to “LLastRow mod 1000”
  [/list]I haven’t really got time to think about it right now, but should be able to post something tonight if you haven’t got it figured out by then…

Reply | Quote

Okay – I thought of a third one….

This version looks at each cell across row 2, and copies either the entire cell (including formulas and formats) or the formats only down to the lLastRow – it will work going as far down the worksheet as 25,000 rows (I presume because it is only pasting one column at a time, instead of 256 columns) – I didn’t test it any further. Processing is very slow – in part because the “Worksheet Change” event for the CR Log sheet forces an inspection of every cell as the macro runs. I would suggest that this functionality be incorporated in the macro specifically, so that as it deals with columns C:E it does the same error correcting as now found in the worksheet code…

Sub CopyFormats()
'  Copies Formats and Formulas from row 2 of "CR Log" (known to be good)
'  to all active rows of that workbook tab.  Formats include conditional
'  formatting, Formulas include validity tests and results

Dim lLastRow        As Long
Dim i               As Integer
Dim ws              As Worksheet

Set ws = Sheet2
lLastRow = ws.UsedRange.Rows.Count

Application.ScreenUpdating = False
ws.Activate
With ws

    For i = 1 To .UsedRange.Columns.Count
        If .Cells(2, i).HasFormula Then
            ' copy cell - includes formula and formatting
            .Cells(2, i).Copy
            .Paste Destination:=Range(.Cells(2, i), .Cells(lLastRow, i))
        Else
            ' copy formatting only
            .Cells(2, i).Copy
            .Range(.Cells(2, i), .Cells(lLastRow, i)).PasteSpecial_ 
                      Paste:=xlFormats, Operation:=xlNone, _ 
                      SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
        End If
    Next i
    Application.CutCopyMode = False
    .Cells(2, 2).Select
    .Calculate
    Range("Database").Resize(lLastRow).Name = "Database"
End With
Set ws = Nothing

Application.ScreenUpdating = True

End Sub

Reply | Quote

Dean,
Thanks for the help. The third one works, and as you state it is slow. I will try to incorporate. Not quite sure how yet.

I will post after I try….

Thanks
Brad

Reply | Quote

Dean,

Could not figure out how to combine the two : ‘workbook change’ and the one you created.

Any help is appreciated…

Brad

Reply | Quote

Brad – I have made one more modification. I assume that you will be adding data periodically. As it is set up now the new formats and formulas are copied down from Row 2 all the way to the bottom of the sheet. This will mean that if you are adding -say- 200 rows at a time, the performance for the first addition will be okay, the second a little worse, the third a little worse still, and so on – the workload will be a function of the total number of rows.

Instead, if you can rely on their being a named range “Database” that coresponds to good data (ie – that you have added before and run this routine on) then you only have to add the formatting and formulas to the new data – from the existing database to the end of the used range. The performance is still pretty slow, but at least it will be consistent, not getting slower and slower (other than the first time you run the routine). If you are satisfied with the state of the w-book now, just ensure that the “Database” range is defined to be the all fo the current data, then add any new data and run the routine below.

The following routine just adds formulas and formatting to the new data:

Sub CopyFormats()
'  Copies Formats and Formulas from row 2 of "CR Log" (known to be good)
'  to all active rows of that workbook tab.  Formats include conditional
'  formatting, Formulas include validity tests and results

Dim lLastRow        As Long
Dim lFirstRow
Dim i               As Integer
Dim ws              As Worksheet

Set ws = Sheet2
lLastRow = ws.UsedRange.Rows.Count
lFirstRow = Range("Database").Rows.Count

Application.ScreenUpdating = False
ws.Activate
With ws

    For i = 1 To .UsedRange.Columns.Count
        If .Cells(2, i).HasFormula Then
            ' copy cell - includes formula and formatting
            .Cells(2, i).Copy
            .Paste Destination:=Range(.Cells(lFirstRow, i), .Cells(lLastRow, i))
        Else
            ' copy formatting only
            .Cells(2, i).Copy
            .Range(.Cells(lFirstRow, i), .Cells(lLastRow, i)).PasteSpecial_ 
                                  Paste:=xlFormats, Operation:=xlNone, _
                                  SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
        End If
    Next i
    Application.CutCopyMode = False
    .Cells(2, 2).Select
    .Calculate
    Range("Database").Resize(lLastRow).Name = "Database"
End With
Set ws = Nothing

Application.ScreenUpdating = True

End Sub

As for combining the w-sheet change event with this routine – I tried running this routine with the “On Change” event deleted, and it wasn’t appreciably faster, although I didn’t time it at all formally.

Reply | Quote

Another suggestion – with the worksheet “On Change” event deleted the routine is speeded up by approximately a factor of six times (by the admittedly imprecise method of counting “One Thousand One / One Thousand Two / One Thousand Three…) by setting the calculation method to “manual” by inserting a line:

Application.Calculation = xlCalculationManual

before the routine starts to do very much. You should then reverse this by setting xlCalculationAutomatic at the end of the routine (although I note that your s/sheet is set to manual re-calc in any event).

Reply | Quote

Dean,
Thanks for all of the help and comments. I will incorporate the latest and let you know. As for the data, I will always have the “database” defined to include all of the data.

Perhaps this will help the speed.

Thanks again,
Brad

Reply | Quote

Dean,
After I added the latest code, I received the following:
run time error 438
Object does not support this property or method

Debug takes me to this line:
.Range(.Cells(lFirstRow, i), .Cells(lLastRow, i)).PasteSpecial_ Paste:=xlFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Also I noticed that one of the items is not set in the Dim

Dim lFirstRow

Regards,
Brad

Reply | Quote

You need a space between PasteSpecial and the Underscore(_):

.Range(.Cells(lFirstRow, i), .Cells(lLastRow, i)).PasteSpecial _
Paste:=xlFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Steve

Reply | Quote

[indent]

---

You need a space between PasteSpecial and the Underscore(_):

---

[/indent]

Sorry – that was my mistake in re-formatting the cut&paste from the VBE to fit better in the Lounge window

Reply | Quote

Hmmm….

I don’t get that error either in XL97 or in XL2K – if you try it again, what row number is it trying to copy to? When you get the error message, click on debug, and then hover your mouse over iLastRow (or set a watch on it) – the only thing I can think of offhand is that you are trying to write past the last row of the s/sheet – perhaps if the “Used Range” has gotten messed up. That reminds me – the “iLastRow” index is set as an integer – if you will be writing down below 16K rows it will have to be dimensioned as a “Long” – I have made that change in the attached file, and in the code below. One other change – I forgot to reset the “Database” name to refer to the new data added to the s/sheet, that is also corrected.

To deal with the wrong Used Range problem, go down to the row immediately below the range that has any data in it. Select from there down to the last row in the sheet, and delete all the selected rows (either with an icon, or by Edit | Delete | select Entire Row | OK), and then do the same thing by deleting the columns to the right of the columns actually used for data. Save the file without making any further changes, and then reopen. If you click on Ctrl-End it should take you to column Z, in the last row with data in it….

Revised Code:

Sub CopyFormats()
'  Copies Formats and Formulas from row 2 of "CR Log" (known to be good)
'  to all active rows of that workbook tab.  Formats include conditional
'  formatting, Formulas include validity tests and results

Dim iLastRow        As Long
Dim i               As Integer
Dim ws              As Worksheet

Set ws = Sheet2
iLastRow = ws.UsedRange.Rows.Count

Application.ScreenUpdating = False
ws.Activate
With ws
    ' copy formatting only
    .Rows("2:2").Copy
    .Rows("2:" & iLastRow).PasteSpecial Paste:=xlFormats, Operation:=xlNone, _
                                        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ' step through columns and copy formulas
    For i = 1 To .UsedRange.Columns.Count
        If .Cells(2, i).HasFormula Then
            .Cells(2, i).Copy
            .Paste Destination:=Range(.Cells(2, i), .Cells(iLastRow, i))
        End If
    Next i
    Application.CutCopyMode = False

    .Cells(2, 2).Select
.Calculate
Range("Database").Resize(iLastRow).Name = "Database"
End With
Set ws = Nothing

Application.ScreenUpdating = True

End Sub

Reply | Quote