Results 1 to 7 of 7
  1. #1
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Adelaide, South Australia, Australia
    Posts
    387
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Copy Borders (XL2000)

    I have been trying without success to write a macro that will paste into a new location the borders only of the cell or cells copied. Can one of our VBA gurus help please?

    TIA.

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: Copy Borders (XL2000)

    This was my attempt (when I started I hadn't seen that Hans had posted a solution).

    I took a different approach. The code asks for source and destination and then transfers the borders. Mine works with diagonals

    Steve


    <pre>Option Explicit
    Sub CopyBorders()
    Dim rSource As Range
    Dim rDest As Range
    Dim iCol As Integer
    Dim lRow As Long
    Dim iBorder As Integer

    On Error Resume Next
    Set rSource = Application.InputBox _
    (Prompt:="Please select the Range to copy FROM", _
    Title:="Copy FROM", Default:=Selection.Address, Type:=8)
    On Error GoTo 0

    If rSource Is Nothing Then
    MsgBox "No Source range was selected"
    Exit Sub
    End If

    On Error Resume Next
    Set rDest = Application.InputBox _
    (Prompt:="Please select the Range to copy TO" & vbCrLf & _
    "NOTE: only Upper left cell is required", _
    Title:="Copy TO", Type:=8)

    On Error GoTo 0

    If rDest Is Nothing Then
    MsgBox "No Destination range was selected"
    Exit Sub
    End If

    With rSource
    For iCol = 1 To .Columns.Count
    For lRow = 1 To .Rows.Count
    For iBorder = 5 To 10
    If .Cells(lRow, iCol).Borders(iBorder).LineStyle <> xlNone Then
    rDest.Cells(lRow, iCol).Borders(iBorder).LineStyle = _
    .Cells(lRow, iCol).Borders(iBorder).LineStyle
    rDest.Cells(lRow, iCol).Borders(iBorder).Weight = _
    .Cells(lRow, iCol).Borders(iBorder).Weight
    rDest.Cells(lRow, iCol).Borders(iBorder).ColorIndex = _
    .Cells(lRow, iCol).Borders(iBorder).ColorIndex
    End If
    Next iBorder
    Next lRow
    Next iCol
    End With
    End Sub</pre>


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

    Re: Copy Borders (XL2000)

    Hi Steve,

    I like your approach <img src=/S/thumbup.gif border=0 alt=thumbup width=15 height=15>, but I think both have their own merits. Yours is very user-friendly and works with diagonal borders; my method allows pasting the same set of borders multiple times.

  4. #4
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: Copy Borders (XL2000)

    I didn't play with your code, why doesn't it work with diagonals?

    I found mine had trouble with diagonal colors since BOTH seem to have the same color (not sure why) so if you had a down diagonal but no up diag, once you set the style, weight and color, of the down when you went to the UP it changed the color. I got around this by first checking for linestyle = xlnone and it never got reset since it never changed anything if it had no style.

    Steve

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

    Re: Copy Borders (XL2000)

    <P ID="edit" class=small>(Edited by HansV on 19-Aug-03 13:31. Some improvements inspired by sdckapr. Thanks, Steve!)</P>The attached zipped workbook contains an attempt to do this. There are three macros in the module basBorders:
    <UL><LI>CopyBorders will save the border settings of the selected range to an array.
    <LI>PasteBorders will paste the saved border settings into the range of the same dimensions as the copied range whose upper left corner is the active cell.
    <LI>ClearBordersClipboard will erase the array, thereby releasing the memory it occupies.[/list]Notes:
    <LI>If the selection consists of multiple areas when running CopyBorders, you'll get a warning and nothing will be copied.
    <LI>The PasteBorders macro does not attempt to adapt the range-to-paste to the current selection, the way Edit | Paste does. The pasted area is always equal in size and shape to the copied area.
    <LI>If you like the macros, drag basBorders to your Personal.xls in the Project Explorer. You can assign keyboard shortcuts and/or custom menu options and/or custom toolbar buttons to the macros. Alternatively, the workbook could be made into an add-in.[/list]Perhaps the Excel gurus will have suggestions for further improvement.

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

    Re: Copy Borders (XL2000)

    Steve, thanks for your tip about checking for linestyle "none". My macros now work for diagonal borders too. I have updated my post and its attachment.

  7. #7
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Adelaide, South Australia, Australia
    Posts
    387
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Copy Borders (XL2000)

    Thanks Hans and Steve. Looks good.

Posting Permissions

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