PDA

View Full Version : Solved: make VBA code shorter



dani9
07-21-2011, 03:53 AM
Hey

how can I make this shorter? it is really bothering me, it takes to much space in the code...

If Sheets("ORMC Performance Report").Range("A2") = True And _
Sheets("ORMC Performance odd").Range("E24").Interior.Color <> RGB(255, 255, 255) Then
Sheets("ORMC Performance Report").Range("F24").Interior.ColorIndex = _
Sheets("ORMC Performance odd").Range("E24").Interior.ColorIndex
End If
If Sheets("ORMC Performance Report").Range("A2") = False And _
Sheets("ORMC Performance even").Range("E24").Interior.Color <> RGB(255, 255, 255) Then
Sheets("ORMC Performance Report").Range("F24").Interior.ColorIndex _
= Sheets("ORMC Performance even").Range("E24").Interior.ColorIndex
End If


If Sheets("ORMC Performance Report").Range("A2") = True And _
Sheets("ORMC Performance odd").Range("G24").Interior.Color <> RGB(255, 255, 255) Then
Sheets("ORMC Performance Report").Range("H24").Interior.ColorIndex = _
Sheets("ORMC Performance odd").Range("G24").Interior.ColorIndex
End If
If Sheets("ORMC Performance Report").Range("A2") = False And _
Sheets("ORMC Performance even").Range("G24").Interior.Color <> RGB(255, 255, 255) Then
Sheets("ORMC Performance Report").Range("H24").Interior.ColorIndex _
= Sheets("ORMC Performance even").Range("G24").Interior.ColorIndex
End If

If Sheets("ORMC Performance Report").Range("A2") = True And _
Sheets("ORMC Performance even").Range("E24").Interior.Color <> RGB(255, 255, 255) Then
Sheets("ORMC Performance Report").Range("G24").Interior.ColorIndex = _
Sheets("ORMC Performance even").Range("E24").Interior.ColorIndex
End If
If Sheets("ORMC Performance Report").Range("A2") = False And _
Sheets("ORMC Performance odd").Range("E24").Interior.Color <> RGB(255, 255, 255) Then
Sheets("ORMC Performance Report").Range("G24").Interior.ColorIndex _
= Sheets("ORMC Performance odd").Range("E24").Interior.ColorIndex
End If


If Sheets("ORMC Performance Report").Range("A2") = True And _
Sheets("ORMC Performance even").Range("G24").Interior.Color <> RGB(255, 255, 255) Then
Sheets("ORMC Performance Report").Range("I24").Interior.ColorIndex = _
Sheets("ORMC Performance even").Range("G24").Interior.ColorIndex
End If
If Sheets("ORMC Performance Report").Range("A2") = False And _
Sheets("ORMC Performance odd").Range("G24").Interior.Color <> RGB(255, 255, 255) Then
Sheets("ORMC Performance Report").Range("I24").Interior.ColorIndex _
= Sheets("ORMC Performance odd").Range("G24").Interior.ColorIndex
End If


thanks in advance for helping me

Bob Phillips
07-21-2011, 04:17 AM
Public Function MyCode()
Dim shEven As Worksheet
Dim shOdd As wqorksheet

Set shEven = Worksheets("ORMC Performance odd")
Set shOdd = Worksheets("ORMC Performance even")
With Worksheets("ORMC Performance Report")

If .Range("A2") = True Then

Call SetColour(.Range("F24"), shEven.Range("E24"), shOdd.Range("E24"))
Call SetColour(.Range("G24"), shEven.Range("E24"), shOdd.Range("E24"))
Call SetColour(.Range("H24"), shEven.Range("G24"), shOdd.Range("G24"))
Call SetColour(.Range("I24"), shEven.Range("G24"), shOdd.Range("G24"))
End If
End With
End Function

Public Function SetColour(Target As Range, EvenCell As Range, OddCell As Range)
If OddCell.Interior.Color <> RGB(255, 255, 255) Then

Target.Interior.ColorIndex = OddCell.Interior.ColorIndex
ElseIf EvenCell.Interior.Color <> RGB(255, 255, 255) Then

Target.Interior.ColorIndex = EvenCell.Interior.ColorIndex
End If
End Function

dani9
07-21-2011, 04:24 AM
it is not working, it colors everything in black.

Bob Phillips
07-21-2011, 04:32 AM
I think I see what I have done wrong, but post the workbook so that I can test it.

Aflatoon
07-21-2011, 04:47 AM
I may have read it incorrectly, but I think this may work:



Sub testing()
Dim wksReport As Excel.Worksheet
Dim wksOdd As Excel.Worksheet
Dim wksEven As Excel.Worksheet

Set wksReport = Sheets("ORMC Performance Report")

If wksReport.Range("A2") = True Then
Set wksOdd = Sheets("ORMC Performance odd")
Set wksEven = Sheets("ORMC Performance even")
Else
Set wksEven = Sheets("ORMC Performance odd")
Set wksOdd = Sheets("ORMC Performance even")
End If

SetColour wksOdd.Range("E24"), wksReport.Range("F24")
SetColour wksOdd.Range("G24"), wksReport.Range("H24")
SetColour wksEven.Range("E24"), wksReport.Range("G24")
SetColour wksEven.Range("G24"), wksReport.Range("I24")

End Sub

Sub SetColour(rng1 As Range, rng2 As Range)
If rng1.Interior.Color <> RGB(255, 255, 255) Then
rng2.Interior.ColorIndex = _
rng1.Interior.ColorIndex
End If
End Sub

dani9
07-21-2011, 04:54 AM
here it is, just the basics, i can not post the whole workbook, but this is all you need

dani9
07-21-2011, 05:00 AM
I may have read it incorrectly, but I think this may work:



Sub testing()
Dim wksReport As Excel.Worksheet
Dim wksOdd As Excel.Worksheet
Dim wksEven As Excel.Worksheet

Set wksReport = Sheets("ORMC Performance Report")

If wksReport.Range("A2") = True Then
Set wksOdd = Sheets("ORMC Performance odd")
Set wksEven = Sheets("ORMC Performance even")
Else
Set wksEven = Sheets("ORMC Performance odd")
Set wksOdd = Sheets("ORMC Performance even")
End If

SetColour wksOdd.Range("E24"), wksReport.Range("F24")
SetColour wksOdd.Range("G24"), wksReport.Range("H24")
SetColour wksEven.Range("E24"), wksReport.Range("G24")
SetColour wksEven.Range("G24"), wksReport.Range("I24")

End Sub

Sub SetColour(rng1 As Range, rng2 As Range)
If rng1.Interior.Color <> RGB(255, 255, 255) Then
rng2.Interior.ColorIndex = _
rng1.Interior.ColorIndex
End If
End Sub


works great, thank you!
i just added to change the font color to white, if the background is black, other than that it works perfectly!

thanks!

Bob Phillips
07-21-2011, 05:09 AM
This should be better. I may have got some of the cells that get coloured wrong, but you should be able to figure out what should be



Public Function MyCode()
Dim shEven As Worksheet
Dim shOdd As Worksheet

Set shEven = Worksheets("Performance even")
Set shOdd = Worksheets("Performance odd")
With Worksheets("Performance Report")

Call SetColour(.Range("A2").Value, .Range("F24"), shEven.Range("E24"), shOdd.Range("E24"))
Call SetColour(.Range("A2").Value, .Range("G24"), shEven.Range("E24"), shOdd.Range("E24"))
Call SetColour(.Range("A2").Value, .Range("H24"), shEven.Range("G24"), shOdd.Range("G24"))
Call SetColour(.Range("A2").Value, .Range("I24"), shEven.Range("G24"), shOdd.Range("G24"))
End With
End Function

Public Function SetColour(IsEven As Boolean, Target As Range, EvenCell As Range, OddCell As Range)
If IsEven Then

If OddCell.Interior.Color <> RGB(255, 255, 255) Then

Target.Interior.ColorIndex = OddCell.Interior.ColorIndex
End If
ElseIf EvenCell.Interior.Color <> RGB(255, 255, 255) Then

Target.Interior.ColorIndex = EvenCell.Interior.ColorIndex
End If
End Function