border column H when column G has data

[Marcel2586]

Hi,

I need help with this one.

I use some code that looks at cells, when not empty draw borders around it.
My dato runs to column G and i need also a border around H as well.
Column H will be a remark box.

This is the code i use.

'border all cells
With Cells.SpecialCells(xlCellTypeConstants, 23)
.BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
On Error Resume Next 'used in case there are no inside borders
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

 

[Rx_]

For speed, let me suggest using something like this
Some comments have been left in as examples.
'If .Cells(i, "B").Value <> .Cells(i - 1, "B").Value Then -- Used in Column B to bold the first instance of data, then gray out the repeating values.

When returning a recordset to Excel, capture the record count in a variable intMaxRecourdCount. I prefer my data to in Excel to put the header information on Row 5 with Data starting on Row 6. This leaves room on top for various titles, dates, and custom count formulas.
Row 5 (5) is put into the intRowPos.

The loop starts at the first row of data and loops to the last row of data in Excel. By using an If (cells row position in the loop, Column) condition
The same or other columns can be formatted.

Using the SpeedUp code posted elsewhere that turns off calculations and screen updating, this can run against large data sets in Excel changing many cells very quickly.
By leaving Excel visible and single stepping through the loop, it is easy to watch the formatting taking place to make adjustments.

  With objxl.ActiveWorkbook.ActiveSheet
    'objxl.ActiveWorkbook.ActiveSheet
        For i = intRowPos To intMaxRecordCount + intRowPos
          'If .Cells(i, "B").Value <> .Cells(i - 1, "B").Value Then
          If .Cells(i, "O").Value = 1 Then  ' 1st sorted order for Lease type
                  .Range(.Cells(i, "B"), .Cells(i, "J")).Font.FontStyle = "Bold"
                  .Range(.Cells(i, "B"), .Cells(i, "J")).Borders(xlTop).ColorIndex = xlAutomatic
                              ' must set back to automatic since Else statement changes style
                  .Range(.Cells(i, "B"), .Cells(i, "J")).Borders(xlTop).Weight = xlThick
          Else
              '.Range(.Cells(i, "B"), .Cells(i, "F")).Font.ColorIndex = 16 'metalic gray 
              If .Cells(i, "O").Value = 4 Then
                      .Range(.Cells(i, "G"), .Cells(i, "H")).Font.FontStyle = "Bold"
              End If

          End If
       Next i
End With

 

[Marcel2586]

Thank you for the quick answer but i get an error when i run it.
error on objxl error 424

 

[Rx_]

Sorry about that. You will have to set an Excel Application object to an object variable named objxl

Here is a full example:
http://btabdevelopment.com/export-tablequery-to-excel-to-new-named-sheet/
In this link's code example:
Set ApXL = CreateObject("Excel.Application")
sets the code reference from Access to a new Excel application.
In my code snip the ApXL is named objxl

Are you running the code from MS Access or from MS Excel?

Attached is an Excel workbook with the code.
Since the code from from within Excel, the objxl object is not needed.
When opening the Excel, Enable Macro so the command button will work.