Vba draw cell border for Cell with data only in column range

Hi Expert,

I am using Access 2003 and Excel 2003.

How do I apply the border line for cells after recordset has appended to Excel worksheet?

The worksheet contained fixed Column heading but with dynamic Row data, I like to draw border line for all the row that contained data in cell.

Thanks.
kaysooAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Harry LeeCommented:
You can use the following code to add simple border from A2 to all used range on sheet.

Sub AddBorderToUsedRange()

Dim rw As Integer, clmn As Integer, ws As Worksheet

Set ws = ActiveSheet
rw = ws.Cells(Rows.Count, 1).End(xlUp).Row
clmn = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    Range(Cells(2, 1), Cells(rw, clmn)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

Open in new window


If simple border is not what you want. Can you please specific what kind of border line you would like to add to different region?

It would work the best if you upload something to show the border line you want if you want the macro changed.
0
kaysooAuthor Commented:
Hi Harry,

TQ for your reply, I have tried your code, however I received two compile errors from the MS Access 2003 VB Editor as shown from the two attached jpg files.  Since I am quite new with vb, can you please show the work around?

The code I used to append the Access recordset to Excel are as follow; the border lines are intended to start from range B10:H10 and for all the rows (B11:H11.....) filled by recordset.

Private Sub Command52_Click()
On Error GoTo Err_Command52_Click
   
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim dbs As DAO.Database
    Set dbs = CurrentDb
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Add
    ApXL.Visible = True
       
    Set xlWSh = xlWBk.Worksheets("Sheet1")
    If Len(strSheetName) > 0 Then
        xlWSh.Name = Left(strSheetName, 34)
    End If
   
    DoCmd.SetWarnings (WarningsOff)
    DoCmd.OpenQuery "MakeTableQuery", acViewNormal, acEdit
    Set rst = dbs.OpenRecordset("MyTable", dbOpenDynaset)
    xlWSh.Activate
    xlWSh.Range("B10").Select ' Header Posting
    For Each fld In rst.Fields
    ApXL.ActiveCell = fld.Name
    ApXL.ActiveCell.Offset(0, 1).Select
    Next
         
   
    rst.MoveFirst
    xlWSh.Range("B10:H10").Font.Bold = True   ' Bold Header
    xlWSh.Range("B11").CopyFromRecordset rst ' Data Posting
    xlWSh.Rows.AutoFit
    xlWSh.Columns.AutoFit
       
   
    rst.Close
    Set rst = Nothing
   
   

   
Exit_Command52_Click:
    Exit Sub

Err_Command52_Click:
    MsgBox Err.Description
    Resume Exit_Command52_Click
Compile-Error-1.jpg
Compile-Error-2.jpg
0
Harry LeeCommented:
The VBA macro I posed was for Excel but not Access.
0
Rowby Goren Makes an Impact on Screen and Online

Learn about longtime user Rowby Goren and his great contributions to the site. We explore his method for posing questions that are likely to yield a solution, and take a look at how his career transformed from a Hollywood writer to a website entrepreneur.

Harry LeeCommented:
I'm not very good at VBA in Access but I'll try my best to help.

Can you add

Dim rw As Integer, clmn As Integer
    rw = rst.RecordCount
    clmn = rst.Fields.Count
    With xlWSh.range(.cells(11, 2), .cells(rw + 10, clmn)).Borders
        .LineStyle = xlContinuous
        .Weight = 3
    End With

Open in new window


between your     xlWSh.Columns.AutoFit and     rst.Close to see if it does the job?

I don't have a database to play with.
0
Harry LeeCommented:
I think I have it figured out.

Can you please try

Private Sub Command52_Click()
On Error GoTo Err_Command52_Click
   
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim dbs As DAO.Database
    Set dbs = CurrentDb
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Add
    ApXL.Visible = True
       
    Set xlWSh = xlWBk.Worksheets("Sheet1")
    If Len(strSheetName) > 0 Then
        xlWSh.Name = Left(strSheetName, 34)
    End If
   
    DoCmd.SetWarnings (WarningsOff)
    DoCmd.OpenQuery "MakeTableQuery", acViewNormal, acEdit
    Set rst = dbs.OpenRecordset("MyTable", dbOpenDynaset)
    xlWSh.Activate
    xlWSh.range("B10").Select ' Header Posting
    For Each fld In rst.Fields
    ApXL.ActiveCell = fld.Name
    ApXL.ActiveCell.Offset(0, 1).Select
    Next

    rst.MoveFirst
    xlWSh.range("B10:H10").Font.Bold = True   ' Bold Header
    xlWSh.range("B11").CopyFromRecordset rst ' Data Posting
    xlWSh.Rows.AutoFit
    xlWSh.Columns.AutoFit
Dim rw As Integer, clmn As Integer
    rw = rst.RecordCount
    clmn = rst.Fields.Count
    With xlWSh.range(xlWSh.cells(10, 2), xlWSh.cells(rw + 10, clmn + 1)).Borders
        .LineStyle = xlContinuous
        .Weight = 2
    End With
   
    rst.Close
    Set rst = Nothing

   

   
Exit_Command52_Click:
    Exit Sub

Err_Command52_Click:
    MsgBox Err.Description
    Resume Exit_Command52_Click
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
kaysooAuthor Commented:
F A N T A S T I C !!!!

Tq very much Harry, it works like a charm, your method is simple and elegant !!

What a life saver......

Thanks again.
0
Harry LeeCommented:
I'm glad I can help
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.