Color Cell interiors in one sheet row range based on cells manually colored on another sheet.

DaveOMatic

Board Regular
Joined
May 13, 2005
Messages
82
Hello Board members....after reading numerous posts...which are very helpful...struggling with trying to do the following.
In sheet 1, range A:A I would color yellow selected cells of 1472 rows...using XLendUp..as the row count can vary. When I color those selected cells, that have a numeric value, I would to find match cell.values, on sheet-2, range A:A...again using VBA of XLendup and color those cell interiors yellow as well, as there are 19727 rows on sheet-2. I have tried every variation of conditional formatting and it only will match / color the first value colored in say Sheet-1, A1 and so on. Thank You in Advance. Dave W.
 
Hello Mumps...trying again here to post the mini-sheets 1 & 2. Here I've selected sheet1 values coloring them Yellow. Running your helpful script..it seems it does pick up the first color selection of sheet1 (A2) but it does not pick up the additional selections in sheet1 A4 & A6, then all occurrences on sheet2 (the destination sheet). Also, I did add Option Explicit to your script as I need to pick up specific number values. The objective eventually is to go through sheet1 selecting cell values coloring them yellow and pick up all identical values coloring them yellow in sheet2. Thanks Kindly.

Color Test.xlsx
ABC
1LIB_SEQDOCUMENT_TYPEWORK_TO_BE_DONE_LANG1
21PFW3A/3B Engines Minimum
32PFWAERO - 3 ENGINE(S) COMPLETE AUDIT (GENERATOR NOT INCLUDED)
43PFWBS - AERO 3A Engine Minimum
54PFWAero Engine 3A Catalyst Test Button R-R
65PFWAero Engine 3a,3b Catalyst
76PFW3A "ENGINE R & R" WITH 3B ENGINE LATER MADE AVAILABLE.
87PFWBS - Aero Unit - 3A Engine "A" Complete
98PFWAERO-3A FUEL TRAIN & WATER INJECTION SYSTEMS, PROVIDING FOR ENGINE COMPT ENTRIES.
1010PFWBS-AERO Engine-3A AC-LOP- #1 (MOP-601)
1111PFWBS-AERO Engine-3A AC-LOP- #2 (MOP-603)
1212PFWBS-AERO Engine-3A DC Emerg LOP (MOP-602)
1313PFWBS - AERO 3B Engine Minimum
1415PFW3B "ENGINE R & R"
1516PFWBS - Aero Unit - 3B Engine "B" Complete
16
17
Sheet1


Color Test.xlsx
AB
1LIB_SEQPOW_EQUIPMENT_NO
21320698
31320698
41320698
51320698
61320698
71320698
81320698
91320698
101320698
111320698
121320698
131320698
141320698
151320698
161320698
171320698
181320698
191320698
201320698
211320698
221320698
231320698
241320698
251320698
261320698
272320698
282320698
292320698
302320698
312320698
322320698
332320698
342320698
352320698
362320698
372320698
382320698
392320698
402320698
412320698
422320698
432320698
442320698
452320698
462320698
472320698
482320698
492320698
502320698
512320698
522320698
532320698
542320698
552320698
562320698
572320698
582320698
592320698
602320698
612320698
622320698
632320698
642320698
652320698
662320698
672320698
682320698
692320698
702320698
712320698
722320698
732320698
742320698
752320698
762320698
772320698
782320698
792320698
802320698
812320698
822320698
833320698
843320698
853320698
863320698
873320698
883320698
893320698
903320698
913320698
923320698
933320698
943320698
954328122
964328122
974328122
984328122
994328122
1004328122
1014328122
1025327290
1035327290
1045327290
1055327290
1065327290
1075327290
1085327290
1095327290
1105327290
1115327290
1126320698
1136320698
1146320698
1156320698
1166320698
1176320698
1186320698
1196320698
1206320698
1216320698
1226320698
1236320698
1246320698
1256320698
1266320698
1276320698
1286320698
1296320698
1306320698
1316320698
1326320698
1336320698
1346320698
1356320698
1366320698
1376320698
1386320698
1396320698
1406320698
1417320698
1427320698
1437320698
1447320698
1457320698
1467320698
1477320698
1487320698
1497320698
1507320698
1517320698
1527320698
1537320698
1547320698
1557320698
1567320698
1577320698
1587320698
1597320698
1607320698
1617320698
1627320698
1637320698
1647320698
1657320698
1667320698
1677320698
1687320698
1698320779
1708320779
1718320779
1728320779
1738320779
1748320779
1758320779
1768320779
1778320779
1788320779
1798320779
18010321395
18110321395
18210321395
18310321395
18410321395
18510321395
18610321395
18710321395
18811321396
18911321396
19011321396
19111321396
19211321396
19311321396
19411321396
19511321396
19612321397
19712321397
19812321397
19912321397
20012321397
20112321397
20212321397
20312321397
20413320788
20513320788
20613320788
20713320788
20813320788
20913320788
21013320788
21113320788
21213320788
21313320788
21413320788
21513320788
21615328123
21715328123
21815328123
21915328123
22015328123
22115328123
22215328123
22315328123
22415328123
22515328123
22615328123
22715328123
22815328123
22915328123
23015328123
23115328123
23215328123
23315328123
23415328123
23515328123
23615328123
23715328123
23815328123
23915328123
24016320698
24116320698
24216320698
24316320698
24416320698
24516320698
24616320698
24716320698
24816320698
24916320698
25016320698
25116320698
25216320698
25316320698
25416320698
25516320698
25616320698
25716320698
25816320698
25916320698
26016320698
26116320698
26216320698
26316320698
26416320698
26516320698
26616320698
26716320698
26817320780
26917320780
27017320780
27117320780
27217320780
27317320780
27417320780
27517320780
27617320780
27717320780
27817320780
27919321398
28019321398
28119321398
28219321398
28319321398
28419321398
28519321398
28619321398
28720321399
28820321399
28920321399
29020321399
29120321399
29220321399
29320321399
29420321399
29521321400
29621321400
29721321400
29821321400
29921321400
30021321400
30121321400
30221321400
30322320875
30422320875
30522320875
30622320875
30722320875
30822320875
30922320875
31022320875
31122320875
31222320875
31322320875
31422320875
31522320875
31622320875
31722320875
31822320875
31923320700
32023320700
32123320700
32223320700
32323320700
32423320700
32523320700
32623320700
32723320700
32823320700
32923320700
33023320700
33123320700
33223320700
33323320700
33423320700
33523320700
33623320700
33723320700
33824320700
33924320700
34024320700
34124320700
34224320700
34324320700
34424320700
34524320700
34624320700
34724320700
34824320700
34924320700
35024320700
35124320700
35224320700
35324320700
35424320700
35524320700
35624320700
35724320700
35824320700
35924320700
36024320700
36124320700
36224320700
36324320700
36424320700
36524320700
36624320700
36724320700
36824320700
36924320700
37024320700
37124320700
37224320700
37324320700
37424320700
37524320700
37624320700
37724320700
37824320700
37924320700
38024320700
38124320700
38224320700
38324320700
38424320700
38524320700
38624320700
38724320700
38824320700
38924320700
39024320700
39124320700
392
Sheet2
 
Upvote 0

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Try:
VBA Code:
Sub ColorCells()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object, i As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
    v2 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        If srcWS.Cells(i + 1, 1).Interior.ColorIndex = 6 Then
            If Not dic.exists(v1(i, 1)) Then
                dic.Add v1(i, 1), i + 1
            End If
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        If dic.exists(v2(i, 1)) Then
            desWS.Cells(i + 1, 1).Interior.ColorIndex = 6
            srcWS.Cells(dic(v2(i, 1)), 1).Interior.ColorIndex = 6
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try:
VBA Code:
Sub ColorCells()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object, i As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
    v2 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        If srcWS.Cells(i + 1, 1).Interior.ColorIndex = 6 Then
            If Not dic.exists(v1(i, 1)) Then
                dic.Add v1(i, 1), i + 1
            End If
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        If dic.exists(v2(i, 1)) Then
            desWS.Cells(i + 1, 1).Interior.ColorIndex = 6
            srcWS.Cells(dic(v2(i, 1)), 1).Interior.ColorIndex = 6
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
Good morning Mumps....I thank you abundantly....the final solution works BEAUTIFULLY. Sequential coloring of cells in the destination sheet as selected in the source sheet has done the job. I'm not sure how to say or post solution achieved but I thank you. Have a great day and thanks for the knowledge. DaveOMatic.
 
Upvote 0
You are very welcome. :)
 
Upvote 0
Solution

Forum statistics

Threads
1,220,965
Messages
6,157,119
Members
451,398
Latest member
rjsteward

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