VBA change cell colour

K

kitsa

Board Regular
Joined
Mar 4, 2016
Messages
111
Office Version
  1. 365
  2. 2016
Hi,
I have created VBA to action my spreadsheet, but I'm lost on how to change a cell colour e.g. cell "O35" to be same colour as cell "N35". It keeps telling error, can anyone help me finish this coding.
Sorry but I don't know how to upload the spreadsheet for you to play with.

VBA Code: 
Private Sub Rollovertest_Click()
Application.DisplayAlerts = False
    Application.ScreenUpdating = False
   Dim i As Long
   Dim Lastrow As Long
Lastrow = Sheet2.Cells(Rows.Count, "B").End(xlUp).Row
    With Sheet2
        For i = 1 To Lastrow
            Select Case .Cells(i, 3).Value
                Case "S", "V": .Cells(i, "AB").Copy: .Cells(i, "AC").PasteSpecial xlPasteValues
            End Select
        Next
    End With
      
   Dim vR As Long, vN As Long
    With Sheet2
        vR = .Columns(1).Find("*", , , , , xlPrevious).Row
        For vN = vR To 2 Step -1
            If .Cells(vN, "O").Value = Range("AH1") Then
                vN2 = vN + 1
               .Rows(vN2).Insert
                .Range(Cells(vN, 1), Cells(vN, "AG")).Copy .Range("A" & vN2)
                .Cells(vN2, "F") = Cells(vN, "F") + 0.01
                .Range("AI1:AJ1").Copy Range(.Cells(vN2, "N"), Cells(vN2, "O"))
                .Range(.Cells(vN2, "T"), Cells(vN2, "V")) = ""
                 With .Range(.Cells(vN2, "T"), Cells(vN2, "V")).Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent2
                    .TintAndShade = 0.599993896298105
                    .PatternTintAndShade = 0
                 End With
                .Range("AC" & vN2) = 0
                .Range("AC" & vN2).NumberFormat = _
                    "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
            End If
        Next vN
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 

Attachments

  • test4.JPG
    test4.JPG
    161.5 KB · Views: 9
  • test4 2.JPG
    test4 2.JPG
    195.2 KB · Views: 10

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
Better you should share sample wrokbook via gg drive, dropbox...then publish the link here
 
Upvote 0
Hi,
Call me stupid or something, I've tried using XL2BB but unsure how its done. I can't work it out or even know how to use drop box?
How do I share, any other suggestions? or can you tell me how to do it step by step?
 
Upvote 0
I wouldn't be able to explain how to use the XL2BB add in any better than what you would find on the link I provided - look under "Usage"
XL2BB add in
How to upload a file to Google Drive:
Upload files & folders to Google Drive - Computer - Google Drive Help
How to share a file via Dropbox:
How to share a Dropbox file or folder

Anyhow, you could try the following on a copy of your workbook and see if it does what you want. Obviously it's untested because you're yet to provide anything to test it on. If it doesn't work for you, I'll wait until you've shared your file before I look at it any further.
VBA Code: 
Option Explicit
Private Sub Rollovertest_Click()
    Application.ScreenUpdating = False
    Dim i As Long, Lastrow As Long, vN2 As Long, ClrIndx As Double
    Lastrow = Sheet2.Cells(Rows.Count, "B").End(xlUp).Row
    With Sheet2
        For i = 1 To Lastrow
            Select Case .Cells(i, 3).Value
                Case "S", "V"
                .Cells(i, "AB").Copy
                .Cells(i, "AC").PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End Select
        Next
        Lastrow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
        For i = Lastrow To 2 Step -1
            If .Cells(i, "O").Value = Range("AH1") Then
                vN2 = i + 1
                .Rows(vN2).Insert
                .Range(Cells(i, "A"), Cells(i, "AG")).Copy .Range("A" & vN2)
                .Cells(vN2, "F") = Cells(i, "F") + 0.01
                .Range("AI1:AJ1").Copy Range(.Cells(vN2, "N"), Cells(vN2, "O"))
                .Range(.Cells(vN2, "T"), Cells(vN2, "V")) = ""
                With .Range(.Cells(vN2, "T"), Cells(vN2, "V")).Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent2
                    .TintAndShade = 0.599993896298105
                    .PatternTintAndShade = 0
                End With
                .Range("AC" & vN2) = 0
                .Range("AC" & vN2).NumberFormat = _
                "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
                ClrIndx = .Range("N" & i).Interior.ColorIndex
                .Range("O" & vN2).Interior.ColorIndex = ClrIndx
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi Kevin,
The VBA didn't work on my spreadsheet.


kevin9999 said:
I wouldn't be able to explain how to use the XL2BB add in any better than what you would find on the link I provided - look under "Usage"
XL2BB add in
How to upload a file to Google Drive:
Upload files & folders to Google Drive - Computer - Google Drive Help
How to share a file via Dropbox:
How to share a Dropbox file or folder

Anyhow, you could try the following on a copy of your workbook and see if it does what you want. Obviously it's untested because you're yet to provide anything to test it on. If it doesn't work for you, I'll wait until you've shared your file before I look at it any further.
VBA Code: 
Option Explicit
Private Sub Rollovertest_Click()
    Application.ScreenUpdating = False
    Dim i As Long, Lastrow As Long, vN2 As Long, ClrIndx As Double
    Lastrow = Sheet2.Cells(Rows.Count, "B").End(xlUp).Row
    With Sheet2
        For i = 1 To Lastrow
            Select Case .Cells(i, 3).Value
                Case "S", "V"
                .Cells(i, "AB").Copy
                .Cells(i, "AC").PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End Select
        Next
        Lastrow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
        For i = Lastrow To 2 Step -1
            If .Cells(i, "O").Value = Range("AH1") Then
                vN2 = i + 1
                .Rows(vN2).Insert
                .Range(Cells(i, "A"), Cells(i, "AG")).Copy .Range("A" & vN2)
                .Cells(vN2, "F") = Cells(i, "F") + 0.01
                .Range("AI1:AJ1").Copy Range(.Cells(vN2, "N"), Cells(vN2, "O"))
                .Range(.Cells(vN2, "T"), Cells(vN2, "V")) = ""
                With .Range(.Cells(vN2, "T"), Cells(vN2, "V")).Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent2
                    .TintAndShade = 0.599993896298105
                    .PatternTintAndShade = 0
                End With
                .Range("AC" & vN2) = 0
                .Range("AC" & vN2).NumberFormat = _
                "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
                ClrIndx = .Range("N" & i).Interior.ColorIndex
                .Range("O" & vN2).Interior.ColorIndex = ClrIndx
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
Click to expand...
 
Upvote 0
no probs, I'll see if I can get this happening. I'll re-read the process and see if I can share it.
 
Upvote 0
When I click on the link, I get stuck on "Converting your file so you can edit it..." but nothing else happens. Therefore, unable to open :(
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
VBA Code to split week ranges into separate lines (additional code required)
Replies
0
Views
452
DotExcel
D
E
  • Solved
formula to return two columns of data adjacent to #N/A cell entry
Replies
3
Views
227
Fluff
Fluff
S
  • Question
VBA Code - Create Log sheet (Errorlog) in case VBA Macro condition is not met
Replies
1
Views
137
Tupe77
T
S
  • Solved
macro copy condition format colours
Replies
5
Views
362
ste33uka
S
Navi_G
  • Question
Want to Run this code as a Personal Marco
Replies
0
Views
371
Navi_G
Navi_G

Forum statistics

Threads
1,215,073
Messages
6,122,976
Members
449,095
Latest member
Mr Hughes

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