Using VBA to colour rows in an alternating pattern

Cark

Registered User.
Local time
Yesterday, 17:50
Joined
Dec 13, 2016
Messages
153
My knowledge of VBA for formatting and colouring cells is pretty ok, but I am struggling with the logic flows/loops especially in this situation where I want to colour rows in groups based on what is exported from a query.

I have attached 2 images a before and after formatting which I would like to have applied.

The column which will drive the formatting is ID. This ID column will never export in a set pattern e.g odd, even, odd, even etc. As you can see from the images, there will be a varying number of rows which have the same ID. The total number of rows used by the export will also vary.

I have made it so my export groups together the IDs so at least that bit is sorted, but how would I go about coding it so that these rows are highlighted in an alternating but grouped pattern.

Thanks :)

EDIT: From looking around on the internet, it seems as though the go to method is to use a helper column. I would rather not use this method as it seems inefficient and supposedly it is doable using conditional formatting + a named range. As my Excel data comes from an Access Query, the range comes in prenamed for me which is really useful. I have tried using the formula suggested in the last post found here https://stackoverflow.com/questions/4146822/excel-shading-entire-row-based-on-change-of-value, but can't seem to get it working. From what I understand all I need to do is to change CurrentRange with my named range (which is qry_reportPart_criteria) in the formula in the conditional formatting of =MOD(Fixed(SUMPRODUCT(1/COUNTIF(CurrentRange,CurrentRange))),2)=0
 

Attachments

  • DelayExport.PNG
    DelayExport.PNG
    17.5 KB · Views: 74
  • DelayExportHowIWouldLike.PNG
    DelayExportHowIWouldLike.PNG
    18.9 KB · Views: 81
Last edited:
Updated with images... sorry.

This is also the code I am currently using and would like to integrate the new code into.

Code:
Sub FormatExcelExportPart(FileName As String)
'Format excel file
'20150531
'http://www.ozgrid.com/forum/showthread.php?t=17608
'http://www.accessibledatasolutions.com/articles11/AccessToExcel.htm

    Set objApp = CreateObject("Excel.Application")
    objApp.Visible = True
    Set wb = objApp.workbooks.Open(FileName, True, False)
    'select all worksheets & cells In turn
    For Each WS In wb.worksheets
    With WS
            .Cells.Font.Name = "Arial"
            lastrow = .Range("A1").currentregion.Rows.Count
            lastCol = .Range("A1").currentregion.Columns.Count
        .Columns("D").Font.Bold = True
        .Columns("D").Font.Italic = True
        .Range("M:M").NumberFormat = "[hh]:mm"
        .Columns("M:M").Replace ":", ":"
        .Rows(1).Font.Bold = True
        .Rows(1).Font.Italic = False
        .Rows(1).Interior.Color = RGB(200, 200, 200)
        .Rows(1).Font.Color = RGB(0, 0, 0)
        
    End With
    
    Next 'next worksheet
 objApp.sheets(1).Activate
    Set objApp = Nothing
    
End Sub
 
For a start, it seems you are putting yourself on thin ice by not dimensioning variables. However, you need to move through the rows looking for a change in the cell value to toggle the colour.

I also think you need to activate each ws as you loop through them.
Code:
dim lngRow as long, lngColor1 as long, lngColor2 as long, lngColor as long
dim str as string
lngColor1 =rgb(firstcolour)
lngColor2 = rgb(secondcolour)
lngColor = lngColor1
  .activate
   ..
  str =""
  lngRow =1
  do while lngRow <=LastRow
     if .cells(lngRow,4)<> str then
        str = .cells(lngRow,4)
        if lngColor = lngColor1 then
           lngColor = lngColor2
        else
           lngcolor = lngcolor1
        endif
    endif       

     rows(lngRow:lngRow).interior.color = lngColor

    lngRow= lngRow+1
  loop
next ws
Note I have not tested this but it gives the outline of getting your formatting
 
Made a few tweaks to it and now it works just how I wanted it to.

I've also made this into a VBA Macro for Excel so I can pass the macros to people around the office in case they want to make their own buttons in Excel to do the same thing.

It's working nicely now.
 
Care to post it in case it can help others?

Made a few tweaks to it and now it works just how I wanted it to.

I've also made this into a VBA Macro for Excel so I can pass the macros to people around the office in case they want to make their own buttons in Excel to do the same thing.

It's working nicely now.
 

Users who are viewing this thread

Back
Top Bottom