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: 10
  • test4 2.JPG
    test4 2.JPG
    195.2 KB · Views: 11

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
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 Question
VBA Code to split week ranges into separate lines (additional code required)
Replies
0
Views
548
DotExcel
D
G
  • Solved
Skip Row When Column Word Meet
2
Replies
14
Views
313
Peter_SSs
Peter_SSs
M
  • Question Question
Split Excel Workbook to separate .xlsx files for each unique value in Column A, also copy worksheet for Drop Down reference
Replies
9
Views
411
Alex Blakenburg
A
G
  • Solved
Button for a For Loop
Replies
3
Views
109
Joe4
Joe4
C
  • Solved
Need Help VBA
2
Replies
10
Views
410
Trebor76
T

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

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