1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User


  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Need a macro to draw border

Discussion in 'VBA Macros' started by jb, Jul 14, 2017.

  1. jb

    jb Member

    Hi Helpers,
    I have a table with some data. File "format preserve.xls" is uploaded with thread.
    In my sheet, boxes have been created of two cells each with border only around group of two cells.

    I need to drag and drop a box from one location to another location within table.

    Now when I drag and drop for example I11 and I12 cell to L9 and L10 then right border around I11 and I12 box is removed.

    I know that there is no solution to preserve border while drag and drop.

    Many times drag and drop is required to be done.

    So, is it possible to write a macro that will select outline border from font menu and apply it on old location (e.g. I11 and I12) as well as on new location (e.g. L9 and L10).

    Whenever such drag and drop is used, it must apply outline border on old box and new box.

    Note: Drag and drop is most convenient and faster way to shift data for me and other users using this sheet.


    Attached Files:

  2. SirJB7

    SirJB7 Excel Rōnin

    Hi, jb!
    Put this code in worksheet object module (sheet34).
    Code (vb):
    Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range)
        ' constants
       Const ki1stRow = 1 '0=even, 1=odd
       ' declarations
       Dim rngSrc As Range, rngTgt As Range
        Dim I As Integer
        ' start
       With Target
            If .Cells.Count <> 2 Or .Rows.Count <> 2 Or .Columns.Count <> 1 Or (.Row Mod 2) <> ki1stRow Then Exit Sub
        End With
        Set rngSrc = Target
        Set rngTgt = Range(ActiveCell, ActiveCell.Offset(1, 0))
        Application.EnableEvents = False
        Debug.Print rngSrc.Address, rngTgt.Address, Target.Address
        I = I + 1
        If I > 10 Then Exit Sub
        ' process
        rngSrc.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ' end
       Application.CutCopyMode = False
        Application.EnableEvents = True
    End Sub
    Take care of setting all borders of each box or some of them will lack the bottom line.
    ThrottleWorks likes this.
  3. jb

    jb Member

    SirJB7 I placed the code.
    Sir it is not working for all boxes.
    For example when I tried to move I16 and I17 to H18 and H19,
    above border of I16 and I17 box as well as lower border of H18 and H19 box

    Sir please help.
  4. SirJB7

    SirJB7 Excel Rōnin

    Hi, jb!
    Glad you solved it. Thanks for your feedback and welcome back whenever needed or wanted.
  5. shahin

    shahin Active Member

    If locations are adjacent to each other then you might give it a try. It's not a workaround but sometimes you might find it useful.
    Code (vb):

    Sub draw_border()
        Selection.CurrentRegion.Borders.LineStyle = xlContinuous
    End Sub
  6. SirJB7

    SirJB7 Excel Rōnin

    Hi, jb!
    When I advised you of this it was because I've yet detected some a-bit-weird things about the way borders have been set for "all" boxes. There wasn't an uniform way, some of them have all borders set, others have all but bottom, and I assumed (didn't and won't check) that it was because the uploaded file was a sample and not the definitive model.
    So my recommendation is to check that every box (select it and Ctrl-1, borders tab) has all the borders properly set. Then please check again the code and if you happen to find any issue, please come back.

Share This Page