Results 1 to 10 of 10
  1. #1
    4 Star Lounger
    Join Date
    Jan 2003
    Location
    Central Florida, USA
    Posts
    505
    Thanks
    5
    Thanked 0 Times in 0 Posts

    Conditional Formatting subtotals(2003)

    Attached is a spreadsheet with three tabs. The first is raw data exported from Access into Excel. The second tab is the same data, after inserting subtotals, formatting fill and borders, and inserting text in a few locations. The third tab is the VBA code that formats the first sheet to look like the second sheet. I recorded a macro while in Excel, then took the resulting VB code and put it into Access, where I made a few required changes.

    I am sure there is a better and programmatic way to do the formatting instead of the 700+ lines of code. What I am doing, and the order in which I am doing it is:
    1. Export the data to Excel
    2. Open Excel
    3. Insert subtotals
    4. Based on where the subtotals occur,
    a) delete replicated data in Columns A and B
    Insert text identifying the totals line
    c) format column A and subtotal line with border and fill color
    d) format column B and subtotal line with border and fill color and font type (underline)
    5. Insert lines at top of sheet
    6. Put title in A1

    I am pretty sure there is a way to programmatically find the subtotal lines and then format the columns and cells based on the rows where the subtotals occur, but I don't know how to find it, and once found how to tell Excel to fill, format etc. the cells with the appropriate color, border and fonts. In addition to the obvious drawback of a lot of lines of code, if a new continent, country or city is added in Access, when the data is exported to Excel the subtotals lines will no longer be in the same row, so the existing VBA code would be a disaster.


    Is there a good place or resource to go to get ideas? Does anyone here have a suggestion?

    Thanks in advance for your consideration.


    Ken
    Attached Files Attached Files

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Conditional Formatting subtotals(2003)

    I'm not going to analyze all your code, but you can use a loop to find all SUBTOTAL formulas in a column, e.g.

    Dim oCell As Excel.Range
    Dim strFirstAddress As String
    Set oCell = .Range("D").Find(What:="=SUBTOTAL", LookIn:=xlFormulas, _
    LookAt:=xlPart, MatchCase:=False)
    If Not oCell Is Nothing Then
    strFirstAddress = oCell.Address
    Do
    ' Do your thing here
    ' ...
    Set oCell = .Range("D").FindNext(After:=oCell)
    Loop While Not oCell Is Nothing And Not oCell.Address = strFirstAddress
    End If

    The .Range refers to the appropriate Excel object in your code.

    One other remark: in general it isn't necessary to select cells in code. For example, instead of

    .Rows("5:5").Select
    .Selection.Insert Shift:=xlDown

    you can use

    .Rows("5:5").Insert Shift:=xlDown

    and instead of

    .Range("D129:J129").Select
    .Range("A99:A129").Select
    With .Selection.Interior
    .ColorIndex = 34
    .Pattern = xlSolid
    End With

    you can use

    With .Range("A99:A129").Interior
    .ColorIndex = 34
    .Pattern = xlSolid
    End With

    which is both shorter and more efficient. (Note that the first Select is omitted entirely since it isn't used, the second Select overrides the first one)

  3. #3
    4 Star Lounger
    Join Date
    Jan 2003
    Location
    Central Florida, USA
    Posts
    505
    Thanks
    5
    Thanked 0 Times in 0 Posts

    Re: Conditional Formatting subtotals(2003)

    Hans,

    Thanks for the reply. I assumed there was a cleaner and more efficient way. I included the code, not for you to review, but to get an idea of how messy it is. I don't have enough experience in Excel automation to know the shortcuts, but figured someone here would know or would know where I could go to get a better solution.

    Thanks for taking time to respond. I'll test and incorporate your approach tomorrow.


    Ken

  4. #4
    4 Star Lounger
    Join Date
    Jan 2003
    Location
    Central Florida, USA
    Posts
    505
    Thanks
    5
    Thanked 0 Times in 0 Posts

    Re: Conditional Formatting subtotals(2003)

    Hans,

    Using your code and the Offset, I am able to accomplish the formatting. However, I am looping through a For/Next loop to do it (see below). Is there a way to capture the Row and Column from the "oCell" variable? That way I could identify the cells from left to right and format them all at once.

    Thanks in advance for your consideration.


    Ken

    Set oCell = .Range("D").Find(what:="=SUBTOTAL", LookIn:=xlFormulas, _
    LookAt:=xlPart, MatchCase:=False)
    If Not oCell Is Nothing Then
    strFirstAddress = oCell.Address

    Do
    ' Insert blank line below subtotal
    oCell.Offset(1, 0).EntireRow.Insert

    ' ================================================== ======================
    ' Format Subtotal line with medium underline and Yellow

    For i = -2 To 7 Step 1
    With oCell.Offset(0, i)
    .Interior.ColorIndex = 36
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders.Weight = xlMedium

    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    With .Borders(xlEdgeTop)
    .LineStyle = xlNone
    .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    .Borders(xlEdgeRight).LineStyle = xlNone
    Next i
    Set oCell = .Range("D").FindNext(After:=oCell)
    Loop While Not oCell Is Nothing And Not oCell.Address = strFirstAddress
    End If

  5. #5
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Conditional Formatting subtotals(2003)

    oCell.Row is the row number of oCell, and oCell.Column the column number.

  6. #6
    4 Star Lounger
    Join Date
    Jan 2003
    Location
    Central Florida, USA
    Posts
    505
    Thanks
    5
    Thanked 0 Times in 0 Posts
    With that in mind, why is this the incorrect syntax to insert an entire row?
    ' Insert one line below the main subtotal here
    oCell.Rows.Insert shift:=xlDown
    For some reason, this inserts a cell, not a row. I probably overlooking something simple.

    thanks,

    Ken

    [quote name='HansV' post='759652' date='18-Feb-2009 07:00']oCell.Row is the row number of oCell, and oCell.Column the column number.[/quote]

  7. #7
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    oCell.Rows returns a range consisting of all the rows in oCell, but since oCell is a single cell, this is equivalent to oCell itself.

    Instead, use

    oCell.EntireRow.Insert

    (no need to specify Shift:=xlDown since that is the default when inserting an entire row.)

  8. #8
    4 Star Lounger
    Join Date
    Jan 2003
    Location
    Central Florida, USA
    Posts
    505
    Thanks
    5
    Thanked 0 Times in 0 Posts
    Excellent! If you would allow one additional question, if I wanted to insert a line AFTER oCell.EntireRow instead of above it, how would I modify the it?

    Thanks for sharing your brilliance.

    Ken

    [quote name='HansV' post='776213' date='20-May-2009 18:07']oCell.Rows returns a range consisting of all the rows in oCell, but since oCell is a single cell, this is equivalent to oCell itself.

    Instead, use

    oCell.EntireRow.Insert

    (no need to specify Shift:=xlDown since that is the default when inserting an entire row.)[/quote]

  9. #9
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    [quote name='kwvh' post='776217' date='21-May-2009 01:24']if I wanted to insert a line AFTER oCell.EntireRow instead of above it, how would I modify the it?[/quote]
    Try

    oCell.Offset(1, 0).EntireRow.Insert

  10. #10
    4 Star Lounger
    Join Date
    Jan 2003
    Location
    Central Florida, USA
    Posts
    505
    Thanks
    5
    Thanked 0 Times in 0 Posts
    Yes sir. That worked perfectly!

    THANKS.

    [quote name='HansV' post='776219' date='20-May-2009 18:27']Try

    oCell.Offset(1, 0).EntireRow.Insert[/quote]

Posting Permissions

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