Automatically put borders around Data

C

Cyril Beki

Board Regular
Joined
Sep 18, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
Hello Expert,

I've read previous post regarding border (Automatically put borders around my data using VBA),
And i used code provided by Rick Rothsein to try to solve my issue in my Userform VBA but the code will not add the border to the new data automatiacally once data is filled.
Which part of code should be changed in order to make the border automatically filled in as soon as data is added ?
My data Column is starting from A8 to Q8. I want the border to be automatically filled as soon as data is added. Thank you in advance. Can anyone help me. Code is below

VBA Code: 
Dim LastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  With Range("A8", Cells(LastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
    .Columns.AutoFit
  End With
 
Sort by date Sort by votes
Cyril Beki said:
Yes, You got the point, i wanted the border and data at the same time. It doesn't matter click button or not, as long as it produced border the same time with data. below is the code for Add button
VBA Code: 
Dim text As Object
Set text = Sheet6.Range("A5000").End(xlUp)

If txtDown1.Value = "" Then
MsgBox "Fill in the Downtime", vbCritical
Exit Sub
End If

If txtUp1.Value = "" Then
MsgBox "Fill in the Uptime", vbCritical
Exit Sub
End If

Select Case MsgBox("You will saved the recent data" _
& vbCrLf & "Are you sure?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Adding Data")
Case vbNo
Exit Sub
Case vbYes
End Select

'Numbering
Me.txtNo.Value = "=Row()-1"

'Adding command
text.Offset(1, 0).Value = Me.txtNo.Value
text.Offset(1, 1).Value = Me.txtSection.Value
text.Offset(1, 2).Value = Me.txtDate.Value

'Day/Night
If Me.txtDay.Value = True Then
text.Offset(1, 3).Value = "Day"
End If
If Me.txtNight.Value = True Then
text.Offset(1, 3).Value = "Night"
End If

'Shift
If Me.txtA.Value = True Then
text.Offset(1, 4).Value = "A"
End If
If Me.txtB.Value = True Then
text.Offset(1, 4).Value = "B"
End If
If Me.txtC.Value = True Then
text.Offset(1, 4).Value = "C"
End If

'Machine
text.Offset(1, 5).Value = Me.txtMachine.Value

'Category
text.Offset(1, 6).Value = Me.txtCategory.Value

'Tube/Paddle/Side
text.Offset(1, 7).Value = Me.txtTube.Value

'Alarm Message
text.Offset(1, 8).Value = Me.txtAlarm.Value

'Problem
text.Offset(1, 9).Value = Me.txtProblem.Value

'Action Taken
text.Offset(1, 10).Value = Me.txtAction.Value

'Action By
Dim i As Long
Dim strActionBy As String

strActionBy = ""

For i = 0 To txtActionby.ListCount - 1
    If txtActionby.Selected(i) Then strActionBy = IIf(strActionBy = "", txtActionby.List(i), strActionBy & vbLf & txtActionby.List(i)) ' There is a space after comma for readability
Next i

text.Offset(1, 11).Value = strActionBy

'Machine Status
If Me.txtUp.Value = True Then
text.Offset(1, 12).Value = "Up"
End If
If Me.txtDown.Value = True Then
text.Offset(1, 12).Value = "Down"
End If

'Uptime Downtime
text.Offset(1, 13).Value = Me.txtDown1.Value
text.Offset(1, 14).Value = Me.txtUp1.Value
text.Offset(1, 15).Value = _
Abs(TimeValue(Me.txtUp1) - TimeValue(Me.txtDown1))

'Part Change
text.Offset(1, 16).Value = Me.txtPart1.Value

Sheet6.Select
Me.ListBox1.RowSource = Sheet6.Range("Passdown").Address(External:=True)
MsgBox ("Data is added succesfully")

'Clear form after add
Me.txtNo.Value = ""
Me.txtDate.Value = ""
Me.txtSection.Value = ""
Me.txtMachine.Value = ""
Me.txtCategory.Value = ""
Me.txtTube.Value = ""
Me.txtAlarm.Value = ""
Me.txtProblem.Value = ""
Me.txtAction.Value = ""
Me.txtActionby.Value = ""
Me.txtPart1.Value = ""
Me.txtDay.Value = False
Me.txtNight.Value = False
Me.txtA.Value = False
Me.txtB.Value = False
Me.txtC.Value = False
Me.txtUp.Value = False
Me.txtDown.Value = False
Me.txtDown1.Value = ""
Me.txtUp1.Value = ""
End Sub
Click to expand...
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim LastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  If Intersect(Target, Range(Cells(8, 1), Cells(LastRow + 1, LastCol + 1))) Is Nothing Then Exit Sub
  With Range("A8", Cells(LastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
    .Columns.AutoFit
  End With
End Sub

Above is code suggested by MAABADI. I already paste it in worksheet, Refer image for result, it doesnt produced border at the same time with data
 

Attachments

  • No border.PNG
    No border.PNG
    4.3 KB · Views: 6
Upvote 0

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Try this code on command button:
VBA Code: 
Dim text As Object
Set text = Sheet6.Range("A5000").End(xlUp)

If txtDown1.Value = "" Then
MsgBox "Fill in the Downtime", vbCritical
Exit Sub
End If

If txtUp1.Value = "" Then
MsgBox "Fill in the Uptime", vbCritical
Exit Sub
End If

Select Case MsgBox("You will saved the recent data" _
& vbCrLf & "Are you sure?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Adding Data")
Case vbNo
Exit Sub
Case vbYes
End Select

'Numbering
Me.txtNo.Value = "=Row()-1"

'Adding command
text.Offset(1, 0).Value = Me.txtNo.Value
text.Offset(1, 1).Value = Me.txtSection.Value
text.Offset(1, 2).Value = Me.txtDate.Value

'Day/Night
If Me.txtDay.Value = True Then
text.Offset(1, 3).Value = "Day"
End If
If Me.txtNight.Value = True Then
text.Offset(1, 3).Value = "Night"
End If

'Shift
If Me.txtA.Value = True Then
text.Offset(1, 4).Value = "A"
End If
If Me.txtB.Value = True Then
text.Offset(1, 4).Value = "B"
End If
If Me.txtC.Value = True Then
text.Offset(1, 4).Value = "C"
End If

'Machine
text.Offset(1, 5).Value = Me.txtMachine.Value

'Category
text.Offset(1, 6).Value = Me.txtCategory.Value

'Tube/Paddle/Side
text.Offset(1, 7).Value = Me.txtTube.Value

'Alarm Message
text.Offset(1, 8).Value = Me.txtAlarm.Value

'Problem
text.Offset(1, 9).Value = Me.txtProblem.Value

'Action Taken
text.Offset(1, 10).Value = Me.txtAction.Value

'Action By
Dim i As Long
Dim strActionBy As String

strActionBy = ""

For i = 0 To txtActionby.ListCount - 1
    If txtActionby.Selected(i) Then strActionBy = IIf(strActionBy = "", txtActionby.List(i), strActionBy & vbLf & txtActionby.List(i)) ' There is a space after comma for readability
Next i

text.Offset(1, 11).Value = strActionBy

'Machine Status
If Me.txtUp.Value = True Then
text.Offset(1, 12).Value = "Up"
End If
If Me.txtDown.Value = True Then
text.Offset(1, 12).Value = "Down"
End If

'Uptime Downtime
text.Offset(1, 13).Value = Me.txtDown1.Value
text.Offset(1, 14).Value = Me.txtUp1.Value
text.Offset(1, 15).Value = _
Abs(TimeValue(Me.txtUp1) - TimeValue(Me.txtDown1))

'Part Change
text.Offset(1, 16).Value = Me.txtPart1.Value

Sheet6.Select
Me.ListBox1.RowSource = Sheet6.Range("Passdown").Address(External:=True)
MsgBox ("Data is added succesfully")

'Clear form after add
Me.txtNo.Value = ""
Me.txtDate.Value = ""
Me.txtSection.Value = ""
Me.txtMachine.Value = ""
Me.txtCategory.Value = ""
Me.txtTube.Value = ""
Me.txtAlarm.Value = ""
Me.txtProblem.Value = ""
Me.txtAction.Value = ""
Me.txtActionby.Value = ""
Me.txtPart1.Value = ""
Me.txtDay.Value = False
Me.txtNight.Value = False
Me.txtA.Value = False
Me.txtB.Value = False
Me.txtC.Value = False
Me.txtUp.Value = False
Me.txtDown.Value = False
Me.txtDown1.Value = ""
Me.txtUp1.Value = ""
Dim LastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  With Range("A8", Cells(LastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
    .Columns.AutoFit
  End With
End Sub
 
Upvote 0
This is a lot of code to read through.
Not sure exactly where you want the borders and what type borders.

Here is a sample of a small script I wrote.
VBA Code: 
'Modified 9/26/2021  4:01:34 AM  EDT
Application.ScreenUpdating = False

Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(Lastrow, 1).Value = "New Stuff"

With Cells(Lastrow, 1).Borders
    .LineStyle = xlContinuous
    .ColorIndex = 1
    .TintAndShade = 0
    .Weight = xlThick
End With

Application.ScreenUpdating = True
End Sub
 
Upvote 0
I
maabadi said:
Try this code on command button:
VBA Code: 
Dim text As Object
Set text = Sheet6.Range("A5000").End(xlUp)

If txtDown1.Value = "" Then
MsgBox "Fill in the Downtime", vbCritical
Exit Sub
End If

If txtUp1.Value = "" Then
MsgBox "Fill in the Uptime", vbCritical
Exit Sub
End If

Select Case MsgBox("You will saved the recent data" _
& vbCrLf & "Are you sure?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Adding Data")
Case vbNo
Exit Sub
Case vbYes
End Select

'Numbering
Me.txtNo.Value = "=Row()-1"

'Adding command
text.Offset(1, 0).Value = Me.txtNo.Value
text.Offset(1, 1).Value = Me.txtSection.Value
text.Offset(1, 2).Value = Me.txtDate.Value

'Day/Night
If Me.txtDay.Value = True Then
text.Offset(1, 3).Value = "Day"
End If
If Me.txtNight.Value = True Then
text.Offset(1, 3).Value = "Night"
End If

'Shift
If Me.txtA.Value = True Then
text.Offset(1, 4).Value = "A"
End If
If Me.txtB.Value = True Then
text.Offset(1, 4).Value = "B"
End If
If Me.txtC.Value = True Then
text.Offset(1, 4).Value = "C"
End If

'Machine
text.Offset(1, 5).Value = Me.txtMachine.Value

'Category
text.Offset(1, 6).Value = Me.txtCategory.Value

'Tube/Paddle/Side
text.Offset(1, 7).Value = Me.txtTube.Value

'Alarm Message
text.Offset(1, 8).Value = Me.txtAlarm.Value

'Problem
text.Offset(1, 9).Value = Me.txtProblem.Value

'Action Taken
text.Offset(1, 10).Value = Me.txtAction.Value

'Action By
Dim i As Long
Dim strActionBy As String

strActionBy = ""

For i = 0 To txtActionby.ListCount - 1
    If txtActionby.Selected(i) Then strActionBy = IIf(strActionBy = "", txtActionby.List(i), strActionBy & vbLf & txtActionby.List(i)) ' There is a space after comma for readability
Next i

text.Offset(1, 11).Value = strActionBy

'Machine Status
If Me.txtUp.Value = True Then
text.Offset(1, 12).Value = "Up"
End If
If Me.txtDown.Value = True Then
text.Offset(1, 12).Value = "Down"
End If

'Uptime Downtime
text.Offset(1, 13).Value = Me.txtDown1.Value
text.Offset(1, 14).Value = Me.txtUp1.Value
text.Offset(1, 15).Value = _
Abs(TimeValue(Me.txtUp1) - TimeValue(Me.txtDown1))

'Part Change
text.Offset(1, 16).Value = Me.txtPart1.Value

Sheet6.Select
Me.ListBox1.RowSource = Sheet6.Range("Passdown").Address(External:=True)
MsgBox ("Data is added succesfully")

'Clear form after add
Me.txtNo.Value = ""
Me.txtDate.Value = ""
Me.txtSection.Value = ""
Me.txtMachine.Value = ""
Me.txtCategory.Value = ""
Me.txtTube.Value = ""
Me.txtAlarm.Value = ""
Me.txtProblem.Value = ""
Me.txtAction.Value = ""
Me.txtActionby.Value = ""
Me.txtPart1.Value = ""
Me.txtDay.Value = False
Me.txtNight.Value = False
Me.txtA.Value = False
Me.txtB.Value = False
Me.txtC.Value = False
Me.txtUp.Value = False
Me.txtDown.Value = False
Me.txtDown1.Value = ""
Me.txtUp1.Value = ""
Dim LastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  With Range("A8", Cells(LastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
    .Columns.AutoFit
  End With
End Sub
Click to expand...
It works !! Thank you so much maabadi
 
Upvote 0
My Aswer Is This said:
This is a lot of code to read through.
Not sure exactly where you want the borders and what type borders.

Here is a sample of a small script I wrote.
VBA Code: 
'Modified 9/26/2021  4:01:34 AM  EDT
Application.ScreenUpdating = False

Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(Lastrow, 1).Value = "New Stuff"

With Cells(Lastrow, 1).Borders
    .LineStyle = xlContinuous
    .ColorIndex = 1
    .TintAndShade = 0
    .Weight = xlThick
End With

Application.ScreenUpdating = True
End Sub
Click to expand...
Thank you My Aswer Is This, i'll tried your code as well. Thank you for the help
 
Upvote 0
Cyril Beki said:
Thank you My Aswer Is This, i'll tried your code as well. Thank you for the help
Click to expand...
Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.
You saying automatically confused us. There are ways to write a script when you enter text into a cell the script runs automatically. Like below.
When you enter any value in Range("A1") the script will run.

This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  9/26/2021  4:43:22 AM  EDT
If Target.Address = "$A$1" Then
Target.Offset(, 1).Value = "New Text"

With Target.Offset(, 1).Borders
    .LineStyle = xlContinuous
    .ColorIndex = 3
    .TintAndShade = 0
    .Weight = xlThick
End With
End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Copy/Paste Values multiple outputs with different sizes into one single Excel sheet using VBA
Replies
2
Views
492
daisylee
D
C
  • Solved
Border in different sheet
Replies
3
Views
368
Fluff
Fluff
I
  • Question
Modify VBA script to count rows with data in multiple sheets
Replies
0
Views
94
irishjsk
I
Guna13
  • Question
Help to Optimize Macro Code for Faster Performance
Replies
0
Views
752
Guna13
Guna13
J
  • Question
VBA - Select file, copy sheets, run code in all sheets
Replies
0
Views
526
jocker_boy
J

Forum statistics

Threads
1,215,006
Messages
6,122,666
Members
449,091
Latest member
peppernaut

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top