XL2010 - Con Formatting - Change Absolute to Relative When Copied

T

TechTank

Board Regular
Joined
Sep 5, 2011
Messages
92
Hi there,

I have a bit of a problem with Conditional Formatting (CF) in Excel 2010 when copying data that contains Rules to another worksheet. It is making the references absolute to the Worksheet 1 that it was copied from and not leaving them as relative to the worksheet they were copied to Worksheet 2. I need this to work on the fly as users will be able to copy from Worksheet 1 to Worksheet 2 at will via a VBA Module.

The sheet is setup as this: Worksheet 1 is a Template of data. A user can use a macro that will copy data from Worksheet 1 into another worksheet and the conditional formattin is used to highlight cells that have been completed or not.

Cell B5 contains a number of 1.01 The CF is on Cell B5. The CF Rule is "If cell value (B5) is equal to G5" then Format > Fill with Green and if not then fill with Red.

G5 has a formula that is
Code: 
=IF(H5="Yes",B5,"")
.

H5 contains a drop drown list with "Yes" and "No" in it.

When a user selects "Yes" from a drop down list in Cell H5 the cell in H5 turns Green (conditional formatting working as expected).
The cell G5 looks to H5 and asks "Do you equal Yes?" If the answer is yes then it returns a face value of the number in cell B5 (1.01).
The CF in B5 is supposed to look at G5 and ask "Do you equal the same as B5?". If Yes then it is to turn the cell B5 Green as well.

This works wonderfully on the Template Worksheet I've created (and did in Excel 2003 where it was initially created). However, when a user executes the macro to copy this data to another sheet the CF Rules change from relative to absolute and reference the Template Worksheet instead of the new Worksheet and so I do not get the colour change.

Thanks to anyone reading for taking the time to work through my garble of an explanation.

Mark.
 
Sort by date Sort by votes
Hi Mark,

I made a mock-up of what you describe, but I didn't experience that problem when copying the cells from Worksheet 1 to Worksheet 2.

Could you post your macro that does the Copy-Paste so we can see how you are getting that result?
 
Upvote 0
Hi,

It's a bit of a long winded one but I've included it all for reference. This essentially copies pre-formatted steps from Worksheet1 to Worksheet2 under specific headers:

Code: 
Sub ASP_New_Application()
    
' ### NEW APPLICATION ###
    
    Dim MyRow1 As String
    Dim MyRow2 As String
    Dim MyRow3 As String
    Dim MyRow4 As String
    Dim MyRow5 As String
    Dim MyRow6 As String
    Dim MyRow7 As String
    Dim MyRow8 As String
    
        MyRow1 = "5:22"     'Pre-Deployment Preparation
        MyRow2 = "25:31"    'Deployment
        MyRow3 = "34"    'Post Deployment
        MyRow4 = "37:38"    'Test Deployment
        MyRow5 = "42"    'Pre-Rollback Preparation
        MyRow6 = "45:46"    'Rollback
        MyRow7 = "49"    'Post Rollback
        MyRow8 = "52:53"    'Test Rollback

    Dim FindString As String
    Dim Rng As Range
    Dim AnswerToMessageBox As String
    Dim MessageBoxContent As String
    
' Message Box Information
    MessageBoxContent = "Are you sure you wish to continue with" & vbNewLine & vbNewLine & "with Automated Step Population?"

    AnswerToMessageBox = MsgBox(MessageBoxContent, vbYesNo + vbQuestion, "New Application Step Population...")

    If AnswerToMessageBox = vbYes Then
    GoTo 0
    Else
        GoTo 1
    End If

0:

Application.ScreenUpdating = False

With ActiveSheet.Unprotect

'Enter Search Value between the ""
    FindString = "1"

    If Trim(FindString) <> "" Then

'Set The Search Range Between The ""
        With ActiveSheet.Range("A:A")
            Set Rng = .Find(What:=FindString, After:=.Cells(1, 1), LookIn:=xlValues, _
                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                            MatchCase:=False)

'Moves To The Cell With The Value In
            If Not Rng Is Nothing Then
                Application.GoTo Rng, True

'Copys The Row Specified
                Sheets("New Application Steps").Rows(MyRow1).Copy

'Inserts The Row Copied Above Beneath The Row Found With The Value In
                Rng.Offset(1).EntireRow.Insert

                Else
            End If
        End With
    End If

'Enter Search Value between the ""
    FindString = "2"

    If Trim(FindString) <> "" Then

'Set The Search Range Between The ""
        With ActiveSheet.Range("A:A")
            Set Rng = .Find(What:=FindString, After:=.Cells(1, 1), LookIn:=xlValues, _
                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                            MatchCase:=False)

'Moves To The Cell With The Value In
            If Not Rng Is Nothing Then
                Application.GoTo Rng, True

'Copys The Row Specified
                Sheets("New Application Steps").Rows(MyRow2).Copy

'Inserts The Row Copied Above Beneath The Row Found With The Value In
                Rng.Offset(1).EntireRow.Insert

                Else
            End If
        End With
    End If

'Enter Search Value between the ""
    FindString = "3"

    If Trim(FindString) <> "" Then

'Set The Search Range Between The ""
        With ActiveSheet.Range("A:A")
            Set Rng = .Find(What:=FindString, After:=.Cells(1, 1), LookIn:=xlValues, _
                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                            MatchCase:=False)

'Moves To The Cell With The Value In
            If Not Rng Is Nothing Then
                Application.GoTo Rng, True

'Copys The Row Specified
                Sheets("New Application Steps").Rows(MyRow3).Copy

'Inserts The Row Copied Above Beneath The Row Found With The Value In
                Rng.Offset(1).EntireRow.Insert

                Else
            End If
        End With
    End If

'Enter Search Value between the ""
    FindString = "4"

    If Trim(FindString) <> "" Then

'Set The Search Range Between The ""
        With ActiveSheet.Range("A:A")
            Set Rng = .Find(What:=FindString, After:=.Cells(1, 1), LookIn:=xlValues, _
                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                            MatchCase:=False)

'Moves To The Cell With The Value In
            If Not Rng Is Nothing Then
                Application.GoTo Rng, True

'Copys The Row Specified
                Sheets("New Application Steps").Rows(MyRow4).Copy

'Inserts The Row Copied Above Beneath The Row Found With The Value In
                Rng.Offset(1).EntireRow.Insert

                Else
            End If
        End With
    End If
End With

'Enter Search Value between the ""
    FindString = "5"

    If Trim(FindString) <> "" Then

'Set The Search Range Between The ""
        With ActiveSheet.Range("A:A")
            Set Rng = .Find(What:=FindString, After:=.Cells(1, 1), LookIn:=xlValues, _
                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                            MatchCase:=False)

'Moves To The Cell With The Value In
            If Not Rng Is Nothing Then
                Application.GoTo Rng, True

'Copys The Row Specified
                Sheets("New Application Steps").Rows(MyRow5).Copy

'Inserts The Row Copied Above Beneath The Row Found With The Value In
                Rng.Offset(1).EntireRow.Insert

                Else
            End If
        End With
    End If

'Enter Search Value between the ""
    FindString = "6"

    If Trim(FindString) <> "" Then

'Set The Search Range Between The ""
        With ActiveSheet.Range("A:A")
            Set Rng = .Find(What:=FindString, After:=.Cells(1, 1), LookIn:=xlValues, _
                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                            MatchCase:=False)

'Moves To The Cell With The Value In
            If Not Rng Is Nothing Then
                Application.GoTo Rng, True

'Copys The Row Specified
                Sheets("New Application Steps").Rows(MyRow6).Copy

'Inserts The Row Copied Above Beneath The Row Found With The Value In
                Rng.Offset(1).EntireRow.Insert

                Else
            End If
        End With
    End If

'Enter Search Value between the ""
    FindString = "7"

    If Trim(FindString) <> "" Then

'Set The Search Range Between The ""
        With ActiveSheet.Range("A:A")
            Set Rng = .Find(What:=FindString, After:=.Cells(1, 1), LookIn:=xlValues, _
                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                            MatchCase:=False)

'Moves To The Cell With The Value In
            If Not Rng Is Nothing Then
                Application.GoTo Rng, True

'Copys The Row Specified
                Sheets("New Application Steps").Rows(MyRow7).Copy

'Inserts The Row Copied Above Beneath The Row Found With The Value In
                Rng.Offset(1).EntireRow.Insert

                Else
            End If
        End With
    End If

'Enter Search Value between the ""
    FindString = "8"

    If Trim(FindString) <> "" Then

'Set The Search Range Between The ""
        With ActiveSheet.Range("A:A")
            Set Rng = .Find(What:=FindString, After:=.Cells(1, 1), LookIn:=xlValues, _
                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                            MatchCase:=False)

'Moves To The Cell With The Value In
            If Not Rng Is Nothing Then
                Application.GoTo Rng, True

'Copys The Row Specified
                Sheets("New Application Steps").Rows(MyRow8).Copy

'Inserts The Row Copied Above Beneath The Row Found With The Value In
                Rng.Offset(1).EntireRow.Insert

                Else
            End If
        End With
    End If

Application.ScreenUpdating = True

Range("C7").Select

' Message Box Information
    MessageBoxContent = "CAUTION: These Steps can only be removed MANUALLY if you click 'OK'." & vbNewLine & vbNewLine & "To remove these Steps click 'Cancel' or click 'OK' to accept them and continue."

    AnswerToMessageBox = MsgBox(MessageBoxContent, vbOKCancel + vbExclamation, "Automated Step Population Completed...")

    If AnswerToMessageBox = vbCancel Then
    GoTo Remove
    Else
        GoTo 1
    End If

Remove:

Application.ScreenUpdating = True

With ActiveSheet.Unprotect
    Rows(MyRow8).Delete

With ActiveSheet.Unprotect
    Rows(MyRow7).Delete

With ActiveSheet.Unprotect
    Rows(MyRow6).Delete

With ActiveSheet.Unprotect
    Rows(MyRow5).Delete
    
With ActiveSheet.Unprotect
    Rows(MyRow4).Delete

With ActiveSheet.Unprotect
    Rows(MyRow3).Delete

With ActiveSheet.Unprotect
    Rows(MyRow2).Delete

With ActiveSheet.Unprotect
    Rows(MyRow1).Delete

With ActiveSheet.Unprotect
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowInsertingRows:=True, AllowDeletingRows _
        :=True
            
                                End With
                            End With
                        End With
                    End With
                End With
            End With
        End With
    End With
End With

' Message Box Information
    MessageBoxContent = "The common Steps for a New Application deployment have been removed."
    
    AnswerToMessageBox = MsgBox(MessageBoxContent, vbOKOnly + vbInformation, "Steps Removed Successfully...")
    
    If AnswerToMessageBox = vbOKOnly Then
    GoTo 1
    Else
        GoTo 1
    End If

1:

Application.ScreenUpdating = True

End Sub

Thanks,

Mark.
 
Upvote 0
An edited version without the repeating code of the above full code.

Code: 
Sub ASP_New_Application()
    
' ### NEW APPLICATION ###
    
    Dim MyRow1 As String
    
        MyRow1 = "5:22"     'Pre-Deployment Preparation

    Dim FindString As String
    Dim Rng As Range

Application.ScreenUpdating = False

With ActiveSheet.Unprotect

'Enter Search Value between the ""
    FindString = "1"

    If Trim(FindString) <> "" Then

'Set The Search Range Between The ""
        With ActiveSheet.Range("A:A")
            Set Rng = .Find(What:=FindString, After:=.Cells(1, 1), LookIn:=xlValues, _
                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                            MatchCase:=False)

'Moves To The Cell With The Value In
            If Not Rng Is Nothing Then
                Application.GoTo Rng, True

'Copys The Row Specified
                Sheets("New Application Steps").Rows(MyRow1).Copy

'Inserts The Row Copied Above Beneath The Row Found With The Value In
                Rng.Offset(1).EntireRow.Insert

                Else
            End If
        End With
    End If

Application.ScreenUpdating = True

End Sub
 
Upvote 0
Mark,

The reason we were getting different results is that your code is doing a Copy-Insert-Paste and I was testing a Copy-Paste.

The Paste of the CF will work as desired if you break the Insert and Copy-Paste into two steps like this...

Code: 
Sub ASP_New_Application()
' ### NEW APPLICATION ###
    Dim MyRow1 As String
    Dim lRows As Long
        MyRow1 = "5:22"     'Pre-Deployment Preparation
        
    Dim FindString As String
    Dim Rng As Range

    Application.ScreenUpdating = True 'False
    ActiveSheet.Unprotect

'Enter Search Value between the ""
    FindString = "1"

    If Trim(FindString) <> "" Then

'Set The Search Range Between The ""
        With ActiveSheet.Range("A:A")
            Set Rng = .Find(What:=FindString, After:=.Cells(1, 1), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                MatchCase:=False)
        End With
'Finds The Cell With The Value In
        If Not Rng Is Nothing Then
            lRows = Rows(MyRow1).Rows.Count
            Rng.Offset(1).EntireRow.Resize(lRows).Insert Shift:=xlDown, _
                CopyOrigin:=xlFormatFromLeftOrAbove

'Copys The Row Specified and Pastes it Beneath The Row Found With The Value In
            Sheets("New Application Steps").Rows(MyRow1).Copy _
                Destination:=Rng.Offset(1)
        End If
    End If
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks Jerry and sorry about that.

I'll take a look at your suggestion and try to to understand it so I know what I'm talking about if I have a problem. Thank you for your help and sticking with it, it's really appreciated.

Mark.
 
Upvote 0
Hi Jerry,

I see what you've done and it's perfect!!! A quick question if you'll indulge me:

Code: 
lRows = Rows(MyRow1).Rows.Count

Now I understand that the lRows is declared 'Dim lRows As Long' but what does that mean and does the code above simply count the amount of rows in the variable I've declared of MyRow1 (Rows 5:22) and insert as many as it counts before pasting the data across?

That's my understanding but I'd like to check I'm understanding it right.

Thank you so much for this and all your help and patience.

Mark.
 
Upvote 0
Mark,

You're welcome. I'm glad to hear that helped. :)

In response to your question, declaring lRows as a Long data type allows it handle the maximum number of rows you could select on an xl2010 sheet.

If you declared it as an Integer data type, there would be an error if MyRow1 ever consisted of more than 32,767 rows.

That's probably unlikely to happen, but it's good practice to use a Long any time you declare a variable that will be used to store a row count.

Your interpretation of how the code works is correct. The first statement here counts the number of rows in MyRows. The second statement inserts that number of rows at the right place.

Code: 
          lRows = Rows(MyRow1).Rows.Count
            Rng.Offset(1).EntireRow.Resize(lRows).Insert Shift:=xlDown, _
                CopyOrigin:=xlFormatFromLeftOrAbove
 
Upvote 0
Jerry, as they say in America: "You da man!".

Thanks for all your help and in explaining your code. I'll be sure to apply the principles above to my code in future.

Much appreciated,

Mark.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Conditional Formatting - apply rules to multiple rows based on specific cells (drop down menus)
Replies
4
Views
1K
AndyB86
A
P
  • Solved
copying conditional formatting
Replies
8
Views
416
plettieri
P
V
  • Question Question
Disallowing user to change cell color
Replies
5
Views
221
Logit
Logit
J
  • Solved
Dont fix cell colour if cell has no Interior colour or Conditional Formatting
2
Replies
11
Views
854
Joe4
Joe4
Cliffork
  • Solved
Conditional Formatting not working properly with AND function
Replies
4
Views
209
Joe4
Joe4

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top