Good people,
I have a spreadsheet. My objective is to draw a line after writing each record. The purpose of this is for clarity - to denote the end of each record.

Please see attachment for example of my spreadsheet and where I want the line to be. Note: I drew the line manually.

Below is the module that produced the spreadsheet.

``````ii = 5
w = 0
For Each R In xlWksht.Range("A5:M5"): w = w + R.ColumnWidth: Next

rht = xlWksht.Range("A5").RowHeight

Do Until M.qBW.EOF = True
ii = ii + 2
xlWksht.Cells(ii, 1).Value = M.qBW![Req No]
xlWksht.Cells(ii, 2).Value = M.qBW![Description]
xlWksht.Cells(ii, 3).Value = M.qBW![ClientName] & Chr(10) & M.qBW![Status]
xlWksht.Cells(ii, 4).Value = M.qBW![P L] & Chr(10) & M.qBW![TotalProg1Hrs]

SrchCriteria = "[Name]= " & "'" & M.qBW![Personnel2] & "'"
rsinPers.FindFirst SrchCriteria
If rsinPers.NoMatch = False Then
xlWksht.Cells(ii, 5).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg2Hrs]
End If

SrchCriteria = "[Name]= '" & M.qBW![Personnel3] & "'"
rsinPers.FindFirst SrchCriteria
If rsinPers.NoMatch = False Then
xlWksht.Cells(ii, 6).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg3Hrs]
End If

SrchCriteria = "[Name]= '" & M.qBW![Personnel4] & "'"
rsinPers.FindFirst SrchCriteria
If rsinPers.NoMatch = False Then
xlWksht.Cells(ii, 7).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg4Hrs]
End If

SrchCriteria = "[Name]= '" & M.qBW![Personnel5] & "'"
rsinPers.FindFirst SrchCriteria
If rsinPers.NoMatch = False Then
xlWksht.Cells(ii, 8).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg5Hrs]
End If

SrchCriteria = "[Name]= '" & M.qBW![Personnel6] & "'"
rsinPers.FindFirst SrchCriteria
If rsinPers.NoMatch = False Then
xlWksht.Cells(ii, 9).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg6Hrs]
End If

xlWksht.Cells(ii, 10).Value = "-" & Chr(10) & M.qBW.Fields("Per Hrs")
xlWksht.Cells(ii, 11).Value = M.qBW.Fields("EstimatedTotalHours") & Chr(10) & M.qBW.Fields("Tot Hrs")
xlWksht.Cells(ii, 12).Value = M.qBW![Start Date] & Chr(10) & M.qBW![Start Date]
xlWksht.Cells(ii, 13).Value = M.qBW![End Date] & Chr(10) & M.qBW![End  Date]
xlWksht.Cells(ii + 1, 1).Value = "Comments:" & Chr(10) & "'" & xlApp.Clean(Trim(M.qBW![Comments]))

With xlWksht.Range(Cells(ii + 1, 1), Cells(ii + 1, 5))
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.IndentLevel = 0
.Font.Size = 10
.MergeCells = True
.RowHeight = .Font.Size * (Len(xlWksht.Range("A" & ii + 1).text) - Len("Comments:")) / w + rht + (rht - .Font.Size)
End With
M.qBW.MoveNext
Loop``````

Thanks,
tgifgemini.

Hello,
I tweaked it with the code below to accomplish the above objective, but is there a more efficient way of doing it?

``xlWksht.Cells(ii + 1, 1).Value = "Comments:" & Chr(10) & "'" & xlApp.Clean(Trim(M.qBW![Comments])) & Chr(10) & "_____________________________________________________________________________________________________________________________"``

tgifgemini.

Hi,

Check this Code, Write at the end and before the "Loop":

Dim TStr As STring

``````TStr = "A" & CStr(ii+1) & ":M" & CStr(ii+1)
Range(TStr).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone``````

REgards
Veena

Hi Veena.
Thanks for your input. I do apppreciate it very much.
Have a wonderful weekend.
tgif.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.