VBA Color Copier

Question

I am very new to VBA. I have been trying to find the right VBA stuff to use to be able to copy over colors from another sheet. There are 6 different sheets in which I want to change the colors on the first sheet and want the designated cells in the next 5 sheets to change colors. I feel like I am so close but the Ranges and Cells are not registering as a value within the Locals tab. I am doing all of this to just calculate the stats per color per category.Locals Tab Zoomed InCoding with Locals TabSpreadsheet&nbsp;Sub Copy_Cell_Color_to_Another_Sheet()
Dim OverallSheet As Worksheet
Dim DWeldsSheet As Worksheet
Dim AWeldsSheet As Worksheet
Dim LoosePigtailsSheet As Worksheet
Dim TeeDowncomerSheet As Worksheet
Dim HeadersSheet As Worksheet
Dim OverallRange As RANGE
Dim DWeldsRange As RANGE
Dim AWeldsRange As RANGE
Dim LoosePigtailsRange As RANGE
Dim TeeDowncomerRange As RANGE
Dim HeadersRange As RANGE
Dim OverallCell As RANGE
Dim DWeldsCell As RANGE
Dim AWeldsCell As RANGE
Dim LoosePigtailsCell As RANGE
Dim TeeDowncomerCell As RANGE
Dim HeadersCell As RANGE
Set OverallSheet = ThisWorkbook.Worksheets("Overall")
Set DWeldsSheet = ThisWorkbook.Worksheets("DWelds")
Set AWeldsSheet = ThisWorkbook.Worksheets("AWelds")
Set LoosePigtailsSheet = ThisWorkbook.Worksheets("LoosePigtails")
Set TeeDowncomerSheet = ThisWorkbook.Worksheets("TeeDowncomer")
Set HeadersSheet = ThisWorkbook.Worksheets("Headers")
Set OverallRange = OverallSheet.RANGE("G11:BF42")
Set DWeldsRange = DWeldsSheet.RANGE("G11:O11,R11:X11,AO11:AU11,AX11:BF11,G15:O15,R15:X15,AO15:AU15,AX15:BF15,G20:O20,R20:X20,AO20:AU20,AX20:BF20,G24:O24,R24:X24,AO24:AU24,AX24:BF24,G29:O29,R29:X29,AO29:AU29,AX29:BF29,G33:O33,R33:X33,AO33:AU33,AX33:BF33,G38:O38,R38:X38,AO38:AU38,AX38:BF38,G42:O42,R42:X42,AO42:AU42,AX42:BF42")
Set AWeldsRange = AWeldsSheet.RANGE("G12:O12,R12:X12,AO12:AU12,AX12:BF12,G14:O14,R14:X14,AO14:AU14,AX14:BF14,G21:O21,R21:X21,AO21:AU21,AX21:BF21,AX23:BF23,AO23:AU23,R23:X23,G23:O23,G30:O30,R30:X30,AO30:AU30,AX30:BF30,G32:O32,R32:X32,AO32:AU32,AX32:BF32,G39:O39,R39:X39,AO39:AU39,AX39:BF39,G41:O41,R41:X41,AO41:AU41,AX41:BF41")
Set LoosePigtailsRange = LoosePigtailsSheet.RANGE("P12:Q12,Y12:AN12,AV12:AW12,P14:Q14,Y14:AN14,AV14:AW14,P21:Q21,Y21:AN21,AV21:AW21,P23:Q23,Y23:AN23,AV23:AW23,P30:Q30,Y30:AN30,AV30:AW30,P32:Q32,Y32:AN32,AV32:AW32,P39:Q39,Y39:AN39,AV39:AW39,P41:Q41,Y41:AN41,AV41:AW41")
Set TeeDowncomerRange = TeeDowncomerSheet.RANGE("AF13,AF22,AF31,AF40")
Set HeadersRange = HeadersSheet.RANGE("G13:AE13,AH13:BF13,G22:AE22,AH22:BF22,G31:AE31,AH31:BF31,G40:AE40,AH40:BF40")
    
For Each OverallCell In OverallRange
    Set DWeldsCell = Cells(OverallCell.Row, OverallCell.Column)
    DWeldsCell.Interior.COLOR = OverallCell.Interior.COLOR
        
Next OverallCell

For Each OverallCell In OverallRange
    Set AWeldsCell = Cells(OverallCell.Row, OverallCell.Column)
    AWeldsCell.Interior.COLOR = OverallCell.Interior.COLOR

Next OverallCell

For Each OverallCell In OverallRange
    Set LoosePigtailsCell = Cells(OverallCell.Row, OverallCell.Column)
    LoosePigtailsCell.Interior.COLOR = OverallCell.Interior.COLOR
    
Next OverallCell

For Each OverallCell In OverallRange
    Set TeeDowncomerCell = Cells(OverallCell.Row, OverallCell.Column)
    TeeDowncomerCell.Interior.COLOR = OverallCell.Interior.COLOR
    
Next OverallCell

For Each OverallCell In OverallRange
    Set HeadersCell = Cells(OverallCell.Row, OverallCell.Column)
    HeadersCell.Interior.COLOR = OverallCell.Interior.COLOR
    
Next OverallCell

End Sub&nbsp;&nbsp;

hansvogelaar · Answer

mmatherne&nbsp;
Cells(OverallCell.Row, OverallCell.Column) is always on the active sheet.
Change
For Each OverallCell In OverallRange
    Set DWeldsCell = Cells(OverallCell.Row, OverallCell.Column)
    DWeldsCell.Interior.COLOR = OverallCell.Interior.COLOR
        
Next OverallCell
to
For Each OverallCell In OverallRange
    Set DWeldsCell = DWeldsSheet.Cells(OverallCell.Row, OverallCell.Column)
    DWeldsCell.Interior.COLOR = OverallCell.Interior.COLOR
        
Next OverallCell
and similar for the other sheets.

hansvogelaar · Answer

mmatherne&nbsp;
Here is a shorter version of the macro:
Sub Copy_Cell_Color_to_Another_Sheet()
    Dim OverallSheet As Worksheet
    Dim DWeldsSheet As Worksheet
    Dim AWeldsSheet As Worksheet
    Dim LoosePigtailsSheet As Worksheet
    Dim TeeDowncomerSheet As Worksheet
    Dim HeadersSheet As Worksheet
    Dim OverallRange As Range
    Dim OverallCell As Range
    Dim DWeldsCell As Range
    Dim AWeldsCell As Range
    Dim LoosePigtailsCell As Range
    Dim TeeDowncomerCell As Range
    Dim HeadersCell As Range
    Set OverallSheet = ThisWorkbook.Worksheets("Overall")
    Set DWeldsSheet = ThisWorkbook.Worksheets("DWelds")
    Set AWeldsSheet = ThisWorkbook.Worksheets("AWelds")
    Set LoosePigtailsSheet = ThisWorkbook.Worksheets("LoosePigtails")
    Set TeeDowncomerSheet = ThisWorkbook.Worksheets("TeeDowncomer")
    Set HeadersSheet = ThisWorkbook.Worksheets("Headers")
    Set OverallRange = OverallSheet.Range("G11:BF42")
    For Each OverallCell In OverallRange
        Set DWeldsCell = DWeldsSheet.Cells(OverallCell.Row, OverallCell.Column)
        DWeldsCell.Interior.Color = OverallCell.Interior.Color
        Set AWeldsCell = AWeldsSheet.Cells(OverallCell.Row, OverallCell.Column)
        AWeldsCell.Interior.Color = OverallCell.Interior.Color
        Set LoosePigtailsCell = LoosePigtailsSheet.Cells(OverallCell.Row, OverallCell.Column)
        LoosePigtailsCell.Interior.Color = OverallCell.Interior.Color
        Set TeeDowncomerCell = TeeDowncomerSheet.Cells(OverallCell.Row, OverallCell.Column)
        TeeDowncomerCell.Interior.Color = OverallCell.Interior.Color
        Set HeadersCell = HeadersSheet.Cells(OverallCell.Row, OverallCell.Column)
        HeadersCell.Interior.Color = OverallCell.Interior.Color
    Next OverallCell
End Sub

hansvogelaar · Answer

mmatherne&nbsp;
But I suspect that what you actually want is the other way round:
Sub Copy_Cell_Color_to_Another_Sheet()
    Dim OverallSheet As Worksheet
    Dim DWeldsSheet As Worksheet
    Dim AWeldsSheet As Worksheet
    Dim LoosePigtailsSheet As Worksheet
    Dim TeeDowncomerSheet As Worksheet
    Dim HeadersSheet As Worksheet
    Dim OverallRange As Range
    Dim DWeldsRange As Range
    Dim AWeldsRange As Range
    Dim LoosePigtailsRange As Range
    Dim TeeDowncomerRange As Range
    Dim HeadersRange As Range
    Dim OverallCell As Range
    Dim DWeldsCell As Range
    Dim AWeldsCell As Range
    Dim LoosePigtailsCell As Range
    Dim TeeDowncomerCell As Range
    Dim HeadersCell As Range
    Set OverallSheet = ThisWorkbook.Worksheets("Overall")
    Set OverallRange = OverallSheet.Range("G11:BF42")

Set DWeldsSheet = ThisWorkbook.Worksheets("DWelds")
    Set DWeldsRange = DWeldsSheet.Range("G11:O11,R11:X11,AO11:AU11,AX11:BF11,G15:O15,R15:X15,AO15:AU15,AX15:BF15,G20:O20,R20:X20,AO20:AU20,AX20:BF20,G24:O24,R24:X24,AO24:AU24,AX24:BF24,G29:O29,R29:X29,AO29:AU29,AX29:BF29,G33:O33,R33:X33,AO33:AU33,AX33:BF33,G38:O38,R38:X38,AO38:AU38,AX38:BF38,G42:O42,R42:X42,AO42:AU42,AX42:BF42")
    For Each DWeldsCell In DWeldsRange
        Set OverallCell = OverallSheet.Cells(DWeldsCell.Row, DWeldsCell.Column)
        OverallCell.Interior.Color = DWeldsCell.Interior.Color
    Next DWeldsCell

Set AWeldsSheet = ThisWorkbook.Worksheets("AWelds")
    Set AWeldsRange = AWeldsSheet.Range("G12:O12,R12:X12,AO12:AU12,AX12:BF12,G14:O14,R14:X14,AO14:AU14,AX14:BF14,G21:O21,R21:X21,AO21:AU21,AX21:BF21,AX23:BF23,AO23:AU23,R23:X23,G23:O23,G30:O30,R30:X30,AO30:AU30,AX30:BF30,G32:O32,R32:X32,AO32:AU32,AX32:BF32,G39:O39,R39:X39,AO39:AU39,AX39:BF39,G41:O41,R41:X41,AO41:AU41,AX41:BF41")
    For Each AWeldsCell In AWeldsRange
        Set OverallCell = OverallSheet.Cells(AWeldsCell.Row, AWeldsCell.Column)
        OverallCell.Interior.Color = AWeldsCell.Interior.Color
    Next AWeldsCell

Set LoosePigtailsSheet = ThisWorkbook.Worksheets("LoosePigtails")
    Set LoosePigtailsRange = LoosePigtailsSheet.Range("P12:Q12,Y12:AN12,AV12:AW12,P14:Q14,Y14:AN14,AV14:AW14,P21:Q21,Y21:AN21,AV21:AW21,P23:Q23,Y23:AN23,AV23:AW23,P30:Q30,Y30:AN30,AV30:AW30,P32:Q32,Y32:AN32,AV32:AW32,P39:Q39,Y39:AN39,AV39:AW39,P41:Q41,Y41:AN41,AV41:AW41")
    For Each LoosePigtailsCell In LoosePigtailsRange
        Set OverallCell = OverallSheet.Cells(LoosePigtailsCell.Row, LoosePigtailsCell.Column)
        OverallCell.Interior.Color = LoosePigtailsCell.Interior.Color
    Next LoosePigtailsCell

Set TeeDowncomerSheet = ThisWorkbook.Worksheets("TeeDowncomer")
    Set TeeDowncomerRange = TeeDowncomerSheet.Range("AF13,AF22,AF31,AF40")
    For Each TeeDowncomerCell In TeeDowncomerRange
        Set OverallCell = OverallSheet.Cells(TeeDowncomerCell.Row, TeeDowncomerCell.Column)
        OverallCell.Interior.Color = TeeDowncomerCell.Interior.Color
    Next TeeDowncomerCell

Set HeadersSheet = ThisWorkbook.Worksheets("Headers")
    Set HeadersRange = HeadersSheet.Range("G13:AE13,AH13:BF13,G22:AE22,AH22:BF22,G31:AE31,AH31:BF31,G40:AE40,AH40:BF40")
    For Each HeadersCell In HeadersRange
        Set OverallCell = OverallSheet.Cells(HeadersCell.Row, HeadersCell.Column)
        OverallCell.Interior.Color = HeadersCell.Interior.Color
    Next HeadersCell
End Sub

mmatherne · Answer

There were more "nothing"'s in the Locals view than the original code. I'm not too sure how to get this right

mmatherne · Answer

For example, this was the original coding I was using when I was just using 3 sheets as a test run. The sheets were labeled: Target, Source, Source2

Sub Copy_Cell_Color_to_Another_Sheet()
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim source2Sheet As Worksheet
Dim sourceRange As Range
Dim targetRange As Range
Dim source2Range As Range
Dim sourceCell As Range
Dim targetCell As Range
Dim source2Cell As Range
Set sourceSheet = ThisWorkbook.Worksheets("Source")
Set targetSheet = ThisWorkbook.Worksheets("Target")
Set source2Sheet = ThisWorkbook.Worksheets("Source2")
Set sourceRange = sourceSheet.Range("B16:D18")
Set targetRange = targetSheet.Range("B16:D18")
Set source2Range = source2Sheet.Range("C8:D8,C11:D11")
Set targetRange = targetSheet.Range("C8:D8,C11:D11")

For Each sourceCell In sourceRange
Set targetCell = Cells(sourceCell.Row, sourceCell.Column)
targetCell.Interior.Color = sourceCell.Interior.Color

Next sourceCell

For Each source2Cell In source2Range
Set targetCell = Cells(source2Cell.Row, source2Cell.Column)
targetCell.Interior.Color = source2Cell.Interior.Color

Next source2Cell

End Sub

Forum Discussion

VBA Color Copier

8 Replies

Resources