Hi again group,
I can't find a way to preserve the condtional formatting on a
worksheet when rows are pasted from another sheet. The condtional
formatting from the sheet that is being searched transfers to the
destination sheet and overwrites or completely removes the condtional
formatting rules from the destination sheet. Here is the macro that I
have modified and it works very well, except for the formatting
problem:
Sub SearchForStringDAILYOUT()
Dim SourceRange As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LSearchValue As Date
Application.Run "Delete"
On Error GoTo Err_Execute
'To keep screen from update flicker
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Fill in the destination sheet and call the LastRow
'function to find the last row
Sheets("DAILYOUT").Select
Lr = Sheets("DAILYOUT").Cells(Rows.Count, "A").End(xlUp).Row
'Date value copied from Weekly Job Log G1
LSearchValue = Range("$G$2")
'Start search in row 2 in JobLogEntry
LSearchRow = 2
'Start copying data to specified row in DAILYOUT (row counter
variable)
LCopyToRow = 4
Sheets("JobLogEntry").Select
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column L = LSearchValue copy entire row to DAILY
If Cells(LSearchRow, "L").Value = LSearchValue Then
'Select row in JobLogEntry to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into DAILYOUT in next row
Sheets("DAILYOUT").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
'With the following line the Conditional Formatting from
JobLogEntry sheet
'is transferred to DAILYOUT SHEET Conditional Formatting Rules
Manager
'which overwrites any rules entered, need a line to preserve the
rules on DAILYOUT
'SHEET
Range("$A$4:$X$500").FormatConditions.Delete
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
Rows(LCopyToRow).Insert
'Go back to JobLogEntry to continue searching
Sheets("JobLogEntry").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A last row of DAILYOUT
Application.CutCopyMode = False
Sheets("DAILYOUT").Select
Range("A2").End(xlDown).Select
ActiveCell.Offset(1, 0).Select
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.Run "Reset"
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
Does anyone have a similar problem or have a fix for this? Any help
will be greatly appreciated!
Thanks in advance!
Ken
--~--~---------~--~----~------------~-------~--~----~
Visit the blog to download Excel tutorials at
http://www.excel-macros.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
For more options, visit this group at
http://groups.google.com/group/excel-macros?hl=en
Visit & Join Our Orkut Community at
http://www.orkut.com/Community.aspx?cmm=22913620
To Learn VBA Macros Please visit http://www.vbamacros.blogspot.com
To see the Daily Excel Tips, Go to:
http://exceldailytip.blogspot.com
If you find any spam message in the group, please send an email to Ayush @
jainayus...@gmail.com
-~----------~----~----~----~------~----~------~--~---
