Format active cell

[staticbob]

Hi,

How would I format the active cell when it is selected, and the one to its right the same. Then copy the data in the 2nd cell to another.

eg, click on cell A1, both A1 AND A2 are highlighted red, AND the value in A2 is copied to A3

Cheers !
Bob

 

[SIXTH SENSE]

Insert this in the standard module of that workbook

Type CellX
    Target As String
    ColorIndex As Integer
End Type

 

[staticbob]

Sorry SS, had opened a new file and forgot that.

Thanks for the help.
Bob

 

[staticbob]

OK, another problem, and I dont think this will be so easy !

I need to retain the formatting for each section. So as my original example posted, shaded in yellow. I can only have one row higlighted in each section !

Like I said, I've got 30 odd sections, all of different size !

Any ideas ?

 

[SIXTH SENSE]

What format?
The code doesnt delete any conditional formating.
It change the background while you want it. now if you want to change the highlighted one, the formating of the previous is restored.
Each time you doble click one row in B, the color in there is saved and regain when other cells are double click.

 

[staticbob]

Sorry, let me try to explain clearer . . .

The code works fine, but I need to do this for each secton. I need to have a formatted selection in each of the sectons.

In section 1.1, I want to be able to double click to select a score, only highlighting one row.
When I move onto section 1.2, I want to retain the format of the cells clicked in the latest row of section 1.1

Is this any clearer ?

Bob

Master Op Ass Feb 04.xls
	A	B	C	D
15	1.1	TenderType		20
16		BillofQuantities	20
17		CostPlus	20
18		TermMaintenance	15
19		Design&Build	15
20		BillofQuantswithCDP	10
21		Spec&Drawings	10
22		ManagementFee	10
23		Bespokecontract/GMP	5
24		Design&BuildNovated	5
25	1.2	ProcurementRoute		30
26		0ther	?
27		2stage	20
28		Partnered	20
29		Negotiated(tenderlist1of1)	30
30		Competitive	15
31		PPP	15
32		PFI	15
Opportunity

 

[SIXTH SENSE]

Hi !
Whats the boundary of its section?

 

[staticbob]

These are the boundries on each of the first 6 sections . . .

B16 - B24
B26 - B32
B41 - B47
B51 - B59
B71 - B76
B79 - B87

Thanks !!! I need to retain a selection (red format) in each one of these sections !

 

[SIXTH SENSE]

Can we not use the markings in A as boundaries?

 

[staticbob]

Yes. That would work the same. I was just highlighting the cells that I would use your double-click code on.

Thanks alot.

 

[SIXTH SENSE]

Hi bob!

You right. Its realy tough!
see if this is what you wanted. and try the code below.

coloring.xls
	A	B	C	D
1			Options	Score
2		PROCUREMENT
3	1.1	Tender??Type		20
4		Bill?of?Quantities	20
5		Cost?Plus	20
6		Term?Maintenance	15
7		Design?&?Build	15
8		Bill?of?Quants?with?CDP	10
9		Spec?&?Drawings	10
10		Management?Fee	10
11		Bespoke?contract?/?GMP	5
12		Design?&?Build?Novated	5
13	1.2	Procurement?Route		20
14		0ther	?
15		2?stage?	20
16		Partnered	20
17		Negotiated?(tender?list?1?of?1)	30
18		Competitive	15
19		PPP	15
20		PFI	15
21	1.3	Commercial?Scope		0-10
22		Marked?subjectively;?between?0?and?10	0-10
23		{any?score?over?5?must?set?out?basis?for?score}
Sheet1

The code!<font face=Courier New><SPAN style="color:#00007F">Private</SPAN><SPAN style="color:#00007F">Sub</SPAN> Worksheet_BeforeDoubleClick(<SPAN style="color:#00007F">ByVal</SPAN> Target<SPAN style="color:#00007F">As</SPAN> Range, Cancel<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Boolean</SPAN>)
    <SPAN style="color:#00007F">Static</SPAN> LastCell<SPAN style="color:#00007F">As</SPAN> CellX
    <SPAN style="color:#00007F">Static</SPAN> Grpcell()<SPAN style="color:#00007F">As</SPAN> CellX
    <SPAN style="color:#00007F">Static</SPAN> Initx<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Boolean</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> isect = Application.Intersect(Target, Range("b:B"))
    <SPAN style="color:#00007F">If</SPAN> isect<SPAN style="color:#00007F">Is</SPAN><SPAN style="color:#00007F">Nothing</SPAN><SPAN style="color:#00007F">Then</SPAN><SPAN style="color:#00007F">Exit</SPAN><SPAN style="color:#00007F">Sub</SPAN>
Redimx:
    <SPAN style="color:#00007F">If</SPAN><SPAN style="color:#00007F">Not</SPAN> Initx<SPAN style="color:#00007F">Then</SPAN>
        <SPAN style="color:#00007F">ReDim</SPAN><SPAN style="color:#00007F">Preserve</SPAN> Grpcell(Application.WorksheetFunction.CountA(Range("a:A")) - 1)<SPAN style="color:#00007F">As</SPAN> CellX
        k = 2<SPAN style="color:#007F00">'blank cel in A before the first entry in A</SPAN>
        <SPAN style="color:#00007F">For</SPAN> I =<SPAN style="color:#00007F">LBound</SPAN>(Grpcell)<SPAN style="color:#00007F">To</SPAN><SPAN style="color:#00007F">UBound</SPAN>(Grpcell) - 1
            <SPAN style="color:#00007F">While</SPAN> Range("A" & k).Value = ""
                k = k + 1
            <SPAN style="color:#00007F">Wend</SPAN>
                st = k
                k = k + 1
            <SPAN style="color:#00007F">While</SPAN> Range("A" & k).Value = ""
                k = k + 1
            <SPAN style="color:#00007F">Wend</SPAN>
                k = k - 1
                en = k
            <SPAN style="color:#00007F">Set</SPAN> Grpcell(I).Rng = Range("b" & st & ":b" & en)
        <SPAN style="color:#00007F">Next</SPAN> I
        <SPAN style="color:#00007F">Set</SPAN> Grpcell(I).Rng = Range("b" & k + 1 & ":b" & Range("b65536").End(xlUp).Row)
        Initx =<SPAN style="color:#00007F">True</SPAN>
    <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">If</SPAN> (Initx) And ((Application.WorksheetFunction.CountA(Range("a:A")) - 1)<><SPAN style="color:#00007F">UBound</SPAN>(Grpcell))<SPAN style="color:#00007F">Then</SPAN>
        Initx =<SPAN style="color:#00007F">False</SPAN>
        <SPAN style="color:#00007F">ReDim</SPAN> Grpcell(0)<SPAN style="color:#00007F">As</SPAN> CellX
        <SPAN style="color:#00007F">GoTo</SPAN> Redimx
    <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">For</SPAN> I =<SPAN style="color:#00007F">LBound</SPAN>(Grpcell)<SPAN style="color:#00007F">To</SPAN><SPAN style="color:#00007F">UBound</SPAN>(Grpcell)
    <SPAN style="color:#00007F">Set</SPAN> isect = Application.Intersect(Grpcell(I).Rng, Target)
    <SPAN style="color:#00007F">If</SPAN><SPAN style="color:#00007F">Not</SPAN> isect<SPAN style="color:#00007F">Is</SPAN><SPAN style="color:#00007F">Nothing</SPAN><SPAN style="color:#00007F">Then</SPAN>
        <SPAN style="color:#00007F">If</SPAN> Grpcell(I).Target<SPAN style="color:#00007F">Is</SPAN><SPAN style="color:#00007F">Nothing</SPAN><SPAN style="color:#00007F">Then</SPAN>
            <SPAN style="color:#00007F">Set</SPAN> Grpcell(I).Target = Target
            Grpcell(I).ColorIndex = Target.Interior.ColorIndex
            Target.Offset(0, 0).Interior.ColorIndex = 3
            Target.Offset(0, 1).Interior.ColorIndex = 3
            <SPAN style="color:#00007F">Exit</SPAN><SPAN style="color:#00007F">For</SPAN>
        <SPAN style="color:#00007F">Else</SPAN>
            Range(Grpcell(I).Target.Address).Interior.ColorIndex = Grpcell(I).ColorIndex
            Range(Grpcell(I).Target.Address).Offset(0, 1).Interior.ColorIndex = Grpcell(I).ColorIndex
            <SPAN style="color:#00007F">Set</SPAN> Grpcell(I).Target = Target
            Grpcell(I).ColorIndex = Target.Interior.ColorIndex
            Target.Offset(0, 0).Interior.ColorIndex = 3
            Target.Offset(0, 1).Interior.ColorIndex = 3
            <SPAN style="color:#00007F">Exit</SPAN><SPAN style="color:#00007F">For</SPAN>
        <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN><SPAN style="color:#00007F">Next</SPAN> I
    <SPAN style="color:#00007F">Set</SPAN> MA = Target.Offset(0, 2).MergeArea
        
        <SPAN style="color:#00007F">If</SPAN> MA.Address = Target.Offset(0, 2).Address<SPAN style="color:#00007F">Then</SPAN>
            Target.Offset(0, 2).Value = Target.Offset(0, 1).Value
            MsgBox ""
        <SPAN style="color:#00007F">Else</SPAN>
            <SPAN style="color:#00007F">If</SPAN> MA.Cells(1, 1).Value<> Target.Offset(0, 1).Value<SPAN style="color:#00007F">Then</SPAN>
                MA.Cells(1, 1).Value = Target.Offset(0, 1).Value
            <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
        <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
    Cancel =<SPAN style="color:#00007F">True</SPAN>
    Application.ScreenUpdating =<SPAN style="color:#00007F">True</SPAN><SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">Sub</SPAN></FONT>