Consulting

Results 1 to 8 of 8

Thread: Make VBA code shorter

  1. 07-21-2011, 03:53 AM #1
    dani9
    dani9 is offline
    VBAX Regular
    Joined
    Apr 2011
    Posts
    43
    Location

    Make VBA code shorter

    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
    Reply With Quote Reply With Quote
  2. 07-21-2011, 04:17 AM #2
    Bob Phillips
    Bob Phillips is offline
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    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
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber
    Reply With Quote Reply With Quote
  3. 07-21-2011, 04:24 AM #3
    dani9
    dani9 is offline
    VBAX Regular
    Joined
    Apr 2011
    Posts
    43
    Location
    it is not working, it colors everything in black.
    Reply With Quote Reply With Quote
  4. 07-21-2011, 04:32 AM #4
    Bob Phillips
    Bob Phillips is offline
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    I think I see what I have done wrong, but post the workbook so that I can test it.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber
    Reply With Quote Reply With Quote
  5. 07-21-2011, 04:47 AM #5
    Aflatoon
    Aflatoon is offline
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,728
    Location
    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
    Reply With Quote Reply With Quote
  6. 07-21-2011, 04:54 AM #6
    dani9
    dani9 is offline
    VBAX Regular
    Joined
    Apr 2011
    Posts
    43
    Location
    here it is, just the basics, i can not post the whole workbook, but this is all you need
    Attached Files Attached Files
    Reply With Quote Reply With Quote
  7. 07-21-2011, 05:00 AM #7
    dani9
    dani9 is offline
    VBAX Regular
    Joined
    Apr 2011
    Posts
    43
    Location
    Quote Originally Posted by Aflatoon
    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!
    Reply With Quote Reply With Quote
  8. 07-21-2011, 05:09 AM #8
    Bob Phillips
    Bob Phillips is offline
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    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
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber
    Reply With Quote Reply With Quote
« Previous Thread | Next Thread »

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

Forum Rules