PDA

View Full Version : Solved: Add Hairline Border Via Vb



hobbiton73
10-07-2012, 06:22 AM
I wonder whether someone may be able to help me please.

I'm using the code below to copy multiple Excel files pasting them in a 'Master' spreadhseet.

Sub BigMerge()

Dim DestCell As Range
Dim DataColumn As Variant
Dim NumberOfColumns As Variant
Dim WB As Workbook
Dim DestWB As Workbook
Dim WS As Worksheet
Dim FileNames As Variant
Dim N As Long
Dim R As Range
Dim StartRow As Long
Dim Lastrow As Long
Dim RowNdx As Long
Dim r1, r2, myMultipleRange As Range

' Create a new workbook for the consolidated
' data.
'Set DestWB = Workbooks.Add
' OR use the ActiveWorkbook:
Set DestWB = ActiveWorkbook
' OR use an open workbook
' Set DestWB = Workbooks("Book1.xls")

' DestCell is the first cell where the consolidated
' data will be written.
Set DestCell = DestWB.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
With DestCell

With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
End With
' DataColumn is the column on the worksheets to be
' consolidated where the actual data is. Data will
' be copied from this column.
DataColumn = "A"

' NumberOfColumns is the number of columns on each
' worksheet to be consolidated from which data will
' be copied. E.g., if your data is in range A1:J100,
' NumberOfColumns would be 10.
NumberOfColumns = 36

' StartRow is the row on the worksheets to be consolidated
' where the data starts. If your worksheet have heading/summary
' rows at the top, set this value to the row number where
' the actual data starts.
StartRow = 5


' Get the workbooks to consolidate
FileNames = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*),*.xls*", _
Title:="Select the workbooks to merge.", MultiSelect:=True)
If IsArray(FileNames) = False Then
If FileNames = False Then
' User cancelled open dialog. get out.
Exit Sub
End If
End If

' Loop through all the selected files.
For N = LBound(FileNames) To UBound(FileNames)
' Open the workbook
Set WB = Workbooks.Open(Filename:=FileNames(N), ReadOnly:=True)
' Loop through all the worksheets in the workbook
For Each WS In WB.Worksheets
With WS
' Test if worksheet has content. It must have
' at least two cells with content. Otherwise,
' it is assumed to be empty and will not be
' processed.
If WS.UsedRange.Cells.Count > 1 Then
' Get the last row in DataColumn
' that has data.
Lastrow = .Cells(.Rows.Count, DataColumn). _
End(xlUp).Row
' Loop through the rows, statring at StartRow
' and going down to LastRow.
For RowNdx = StartRow To Lastrow
' Copy the cells on row RowNdx
' starting in DataColumn for NumberOfColumns'
' columns wide. Data is copied to
' DestCell.
.Cells(RowNdx, DataColumn). _
Resize(1, NumberOfColumns).Copy _
Destination:=DestCell

' Move the DestCell down one row.
Set DestCell = DestCell(2, 1)
Next RowNdx
End If
End With
Next WS
' close the workbook.
WB.Close savechanges:=False
Next N

End Sub

The problem I'm having is in adding a hairline border to the cells. I want to add this after each file is pasted into the 'Master' spreadsheet. But when I run the macro, any pre-exisiting borders which were inherent to the data when copied across are not over written.

In addition, when I try to add the 'Inside Vertical' border I receive the following error
Run-time error '1004': Unable to set the LineStyle property of the Border class

I've read a few articles about how to add Borders via VB, but I'm still not sure where I'm going wrong.

I just wondered whether someone may be able to look at this please and let me know where I'm going wrong.

Many thanks and kind regards

shrivallabha
10-07-2012, 08:03 AM
Test following code:
DestCell.Borders.Weight = xlthin

hobbiton73
10-07-2012, 08:14 AM
Hi, thank you very ,much for replying to my post and for the solution

Forgive me if I've misunderstood, but I removed this section of code:

With DestCell

With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
End With

and I replaced it with your line of code.

If I've done this correctly, then unfortunately this doesn't solve either the 'Inline' border issue or overwriting existing border formats.

Many thanks and kind regards

Leith Ross
10-07-2012, 10:28 AM
Hello hobbiton73,

The macro should now add the borders after the cells have been copied. The added code is in bold.

Sub BigMerge()

Dim DestCell As Range
Dim DataColumn As Variant
Dim NumberOfColumns As Variant
Dim WB As Workbook
Dim DestWB As Workbook
Dim WS As Worksheet
Dim FileNames As Variant
Dim N As Long
Dim R As Range
Dim StartRow As Long
Dim Lastrow As Long
Dim RowNdx As Long
Dim r1, r2, myMultipleRange As Range

' Create a new workbook for the consolidated
' data.
'Set DestWB = Workbooks.Add
' OR use the ActiveWorkbook:
Set DestWB = ActiveWorkbook
' OR use an open workbook
' Set DestWB = Workbooks("Book1.xls")

' DestCell is the first cell where the consolidated
' data will be written.
Set DestCell = DestWB.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
' DataColumn is the column on the worksheets to be
' consolidated where the actual data is. Data will
' be copied from this column.
DataColumn = "A"

' NumberOfColumns is the number of columns on each
' worksheet to be consolidated from which data will
' be copied. E.g., if your data is in range A1:J100,
' NumberOfColumns would be 10.
NumberOfColumns = 36

' StartRow is the row on the worksheets to be consolidated
' where the data starts. If your worksheet have heading/summary
' rows at the top, set this value to the row number where
' the actual data starts.
StartRow = 5

' Get the workbooks to consolidate
FileNames = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*),*.xls*", _
Title:="Select the workbooks to merge.", MultiSelect:=True)
If IsArray(FileNames) = False Then
If FileNames = False Then
' User cancelled open dialog. get out.
Exit Sub
End If
End If

' Loop through all the selected files.
For N = LBound(FileNames) To UBound(FileNames)
' Open the workbook
Set WB = Workbooks.Open(FileName:=FileNames(N), ReadOnly:=True)
' Loop through all the worksheets in the workbook
For Each WS In WB.Worksheets
With WS
' Test if worksheet has content. It must have
' at least two cells with content. Otherwise,
' it is assumed to be empty and will not be
' processed.
If WS.UsedRange.Cells.Count > 1 Then
' Get the last row in DataColumn
' that has data.
Lastrow = .Cells(.Rows.Count, DataColumn). _
End(xlUp).Row
' Loop through the rows, statring at StartRow
' and going down to LastRow.
For RowNdx = StartRow To Lastrow
' Copy the cells on row RowNdx
' starting in DataColumn for NumberOfColumns'
' columns wide. Data is copied to
' DestCell.
.Cells(RowNdx, DataColumn). _
Resize(1, NumberOfColumns).Copy _
Destination:=DestCell

' Add borders to all cells that were copied.
With DestCell.Resize(1, NumberOfColumns)
.Borders.LineStyle = xlLineStyleNone
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
With .Borders(xlInsideVertical)
.Weight = xlThin
.LineStyle = xlContinuous
End With
End With

' Move the DestCell down one row.
Set DestCell = DestCell(2, 1)
Next RowNdx
End If
End With
Next WS
' close the workbook.
WB.Close savechanges:=False
Next N

End Sub

hobbiton73
10-08-2012, 08:08 AM
Hi, thank you for taking the time to reply and for the trouble in putting the solution together.

It works great.

Once again and many thanks

Chris