VBA (Copy/Paste Range) Pasted range color depending on a cell value

zubinnajmi · Apr 19th 2021

Hi All.....

The below mentioned code copies 3 different ranges in 3 different places in the same worksheet.

Without changing the structure or the method of this code (Copy/Paste) I need the following

Every time a range is copied, can all the cells in the pasted range be given a color depending on the value of the cell "F15"

Say If "F15" Value < 1000....... Color of the copied range "Green"

If "F15" Value > 1000 and <10000..... Color of the copied range "Blue"

If "F15" Value > 10000....... Color of the copied range "Red"

And I have a List box which displays this range..... the same color of the range should show up in the listbox.

Thank you for your attention

Code

Sheet1.Range("B4:B14").Copy
    Sheet1.Range("B" & Sheet1.Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row + 1).PasteSpecial xlValues
    Selection.Value = Selection.Value
    
    Sheet1.Range("E4:E14").Copy
    Sheet1.Range("D" & Sheet1.Columns("D").Find("*", , xlValues, , xlRows, xlPrevious).Row + 1).PasteSpecial xlValues
    Selection.Value = Selection.Value
    
    Sheet1.Range("F4:F14").Copy
    Sheet1.Range("E" & Sheet1.Columns("E").Find("*", , xlValues, , xlRows, xlPrevious).Row + 1).PasteSpecial xlValues
    Selection.Value = Selection.Value
        
       
    Application.CutCopyMode = False

Display More

**royUK** · Apr 19th 2021

Yu cannot colour a ListBox like that.

Attach an example workbook

zubinnajmi · Apr 19th 2021

Hi..Thanks for the reply

If there is no way of displaying color in the listbox the the whole purpose is defeated.

My work book is to large and with sensitive information.....please give me time to prepare a sample sheet.

Please see if something can be done.

Thanks

zubinnajmi · Apr 19th 2021

Hi....

This sample worksheet is highly trimmed, but hope it is enough for you to understand.

Originally

Range ("C4:C14") has Vlookup formula

Range ("D4:D14") has Vlookup formula

Range ("F4:F14") has formula

similarly

Range ("A25:A3000") has TimeStamp

Range ("C25:C3000") has Vlookup formula

Range ("F25:F3000") has formula

Ranges Copied

B4:B14.........B25

E4:E14..........D25

F4:F14..........E25

Now every time CommandButton "OK" is executed

The color of all the cells in the range OR cells in the copied column "E" should follow the below condition.

If "F15" Value < 1000....... Color of the copied range "Green"
If "F15" Value > 1000 and <10000..... Color of the copied range "Blue"
If "F15" Value > 10000....... Color of the copied range "Red"

It is fine if these colors can not be shown in my userform listbox.

Please suggest....

**royUK** · Apr 19th 2021

Where is the ListBox? What exactly are you trying to do?

zubinnajmi · Apr 19th 2021

Hi Roy.....but you said you can't color a list box....so i omitted that part,

I'll do with worksheet cell colors.

**royUK** · Apr 20th 2021

You cannot colour a ListBox by individual rows.

Your code seems to copying 3 columns of data. It would be more efficient if the headers matched and the code moved the block of data, instead of column by column

**Carim** · Apr 20th 2021

Hello,

Your question reminded me of a very nice solution proposed a while ago by Andy Pope:

https://andypope.info/vba/colourdropdown.htm

Hope this will help

**royUK** · Apr 20th 2021

Andy's example is for a ComboBox. I don't think it can be used for what the OP wants, i.e. using a ListBox and applying colours like Conditional Formatting

**royUK** · Apr 20th 2021

Is this code doing what you want?

I don't see the need for formulas in the Register. Just add Conditional Formatting to colour the rows.

Code

Private Sub CommandButton1_Click()
    
    Dim rData As Range
    Dim lRw As Long
    
    
    With Sheet1
        lRw = .Cells(15, 5).End(xlUp).row
        Set rData = .Range(.Cells(4, 2), .Cells(lRw, 6))
        lRw = .Cells(.Rows.Count, 2).End(xlUp).row + 1
        rData.Columns(1).Copy .Cells(lRw, 2)
        rData.Columns(2).Copy .Cells(lRw, 3)
        rData.Columns(3).Copy .Cells(lRw, 5)
        rData.Columns(4).Copy .Cells(lRw, 4)
        rData.Columns(5).Copy .Cells(lRw, 6)
        .Range("B4:E14").ClearContents
    End With
    Application.CutCopyMode = False
    
End Sub

Display More

zubinnajmi · Apr 20th 2021

Hi Roy Thanks for the reply.......You are right, adding Conditional Formatting to color the rows works fine and serves my need....

Ill try your code....but maybe its doing what my code is doing...only issue was the color coding

Still ill try out your code and get back...

**royUK** · Apr 20th 2021

My code is more efficient

zubinnajmi · Apr 20th 2021

your code is working fine......

As far as color coding goes i'll go with conditional formating..

Thanks for your attention Roy

**royUK** · Apr 20th 2021

If the layout of each table was the same, i.e. the columns matched then the copy process would be even faster.

**royUK** · Apr 20th 2021

Pleased to help.

Post back if you need further help.

Visit my web site, http://www.excel-it.com, for more examples and some helpful articles.

zubinnajmi · Apr 21st 2021

Thanks a lot Roy......God Bless

VBA (Copy/Paste Range) Pasted range color depending on a cell value

Participate now!

Share