Command Button Shapes I have created this Command Button Shapes For User Form which looks like.
User Form
It has different codes for borders.
When I click UserForm Command Button. It throws me this error.
Error
Can Someone tell where I am wrong?
First Edit:
Private Sub CommandButton1_Click()
Dim rng As Range
Me.CommandButton1.TopLeftCell.Offset(1, -2).Select
Set rng = ActiveSheet.Range("Me.CommandButton1.TopLeftCell.Offset(1, -2)")
rng.Borders.LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
UserForm2.Hide
End Sub
So I figured it out Shape Command Button Code.
Private Sub CommandButton1_Click()
Me.CommandButton1.TopLeftCell.Offset(1, -2).Select
UserForm2.Show
End Sub
And UserForm Code
ActiveCell.Borders.LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
UserForm2.Hide
Related
I am trying to exercise Levenshtein Distance in Excel. To fill the cells, we need to consider the minimum of three cells (left, up-left, and up). It is easy to find minimum of those three if they were highlighted.
I want to highlight those three cells whenever I put my cursor on any empty cell. Just like shown on image below. When I put my cursor on C3; B2, B3, and C2 should be higlighted.
I found a VBA script. But it higlightes the entire row and column of cursor cell. I am not familiar with VBA, therefore can't modify rows and columns to my way.
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Update 20200430
Static xRow
Static xColumn
If xColumn <> "" Then
With Columns(xColumn).Interior
.ColorIndex = xlNone
End With
With Rows(xRow).Interior
.ColorIndex = xlNone
End With
End If
pRow = Selection.Row
pColumn = Selection.Column
xRow = pRow
xColumn = pColumn
With Columns(pColumn).Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With Rows(pRow).Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End Sub
this is what it does
A Worksheet SelectionChange: Highlight Cells
Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target.Cells(1)
If .Row = 1 Then Exit Sub
If .Column = 1 Then Exit Sub
If IsEmpty(.Cells) Then
.Worksheet.UsedRange.Interior.ColorIndex = xlNone
Union(.Offset(-1, -1).Resize(2), .Offset(-1)) _
.Interior.Color = vbYellow
End If
End With
End Sub
I have a range of data which has a combination of merged/unmerged, empty/non empty cells. I currently have the code which skips the empty cells in a given range and adds border to non-empty cells. Here is the code which I wrote.
Set iRange = ea.Range(Cells(2, 1), Cells(EAlastrow, EAlastcol))
For Each iCells In iRange
If iCells.MergeCells Then
If Not IsEmpty(iCells) Then
Dim iCellRange As String
iCellRange = iCells.MergeArea.Address
Range(iCellRange).BorderAround xlContinuous, xlThin
End If
Else
If Not IsEmpty(iCells) Then
iCells.BorderAround xlContinuous, xlThin
End If
End If
Next iCells
Is it possible to set the range in a way that it includes below empty cells too and add a border to it?
This is how the table is structured:
Thanks in advance.
Try this:
Sub SubFormat()
'Declarations.
Dim RngHeader As Range
Dim RngTarget As Range
Dim DblLastRow As Double
Dim DblMaxLastRow As Double
'Setting RngHeader as the first line of the data i want to be formatted.
Set RngHeader = Range("A2:AB2")
'Checking which is the highest value of non empty row for each column of RngHeader.
For Each RngTarget In RngHeader
DblLastRow = Cells(Cells.Rows.Count, RngTarget.Column).End(xlUp).Row
DblMaxLastRow = Excel.WorksheetFunction.Max(DblMaxLastRow, DblLastRow)
Next
'If no data has been found, the macro is terminated.
If DblMaxLastRow < RngHeader.Row Or _
(DblMaxLastRow = RngHeader.Row And Excel.WorksheetFunction.CountBlank(RngHeader) = RngHeader.Cells.Count) _
Then
MsgBox "No data found", vbCritical + vbOKOnly, "No data found"
Exit Sub
End If
'Targeting the data.
With Range(RngHeader.Cells(1, 1), Cells(DblMaxLastRow, RngHeader.Cells(1, RngHeader.Columns.Count).Column))
'Setting the borders' format.
.BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End Sub
You can get the last cell with data for each column and then set border for each cell in that column till the last cell with data. In below code 3 indicates column C
lastRow = Sheet2.Cells(Rows.Count, 3).End(xlUp).Row
Range("C1:C" + CStr(lastRow)).Borders.LineStyle = xlContinuous
You can try this it works fine for me:
Sub ALLBorders()
With Cells.SpecialCells(xlCellTypeConstants, 23)
.BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
On Error Resume Next
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End Sub
Here is the second requirement solution.
Sub BorderMultiRange()
With Sheets("Sheet1").Range("A28:A29,C5:E9,G11:J14")
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
End Sub
I have this code which is below. The highlight is always enable. I am trying to find out how can i create something to enable/disable whenever i want.
Thanks in advance.
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Static xRow
Static xColumn
If xColumn <> "" Then
With Columns(xColumn).Interior
.ColorIndex = xlNone
End With
With Rows(xRow).Interior
.ColorIndex = xlNone
End With
End If
pRow = Selection.Row
pColumn = Selection.Column
xRow = pRow
xColumn = pColumn
With Columns(pColumn).Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With Rows(pRow).Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End Sub
Try,
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.Color = xlNone
If Range("a1") = "" Then Exit Sub 'Set operation according to a1 cell
With Target
.EntireRow.Interior.ColorIndex = 6
.EntireColumn.Interior.ColorIndex = 6
End With
End Sub
It would be nice to insert the activeX control Checkbox in the sheet and set the behavior accordingly.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.Color = xlNone
'If Range("a1") = "" Then Exit Sub
If CheckBox1 Then Exit Sub
With Target
.EntireRow.Interior.ColorIndex = 6
.EntireColumn.Interior.ColorIndex = 6
End With
End Sub
I have a template where the user enters account information and the default range for information is range B18 to S52. This fits nicely onto the screen and is a big enough range for the details being entered 90% of the time. However on a few occasions the use may have data that is a few hundred rows. Its usally copied and pasted in but would make the sheet look messy as it would be out of the default range.
I'm trying make the formatting dynamic where by if the user enters data outside of the default range a macro is triggered that will count the rows and reformat the range.
The code I have so far from researching online is:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$18" Then
Call CountLoc
End If
End Sub
Public Sub CountLoc()
With Application
.DisplayAlerts = False
'.Calculation = xlManual
.EnableEvents = False
.ScreenUpdating = False
End With
Dim LocCount As Long
Dim WsInput As Worksheet
Dim i As Long
Dim rng As Range
Set WsInput = Sheets("Account Input")
With WsInput
LocCount = .Range("B1048576").End(xlUp).row - 17
End With
If LocCount > 35 Then
Set rng = WsInput.Range(WsInput.Cells(18, 2), WsInput.Cells(17 + LocCount, 19))
With rng
.Interior.Color = RGB(220, 230, 241)
.Borders.LineStyle = xlContinuous
.Borders.Color = vbBlack
.Borders.Weight = xlThin
End With
For i = 1 To LocCount Step 2
Rows(18 + i).EntireRow.Interior.Color = vbWhite
Next i
Else
Exit Sub
End If
This essentially colors every other row light blue and white and adds a border to each cell. The Count Loc works fine and does what I need it to do but the problem I have is that I cannot get the worksheet_Change to trigger.
Thanks in advance
there
I ran a little test using your code and the first thing I noticed, is that you set the Application.EnableEvents to False and you don't set it back on, so you are cancelling any event like the Worksheet_Change Event once that's fix the event will trigger any time the cell B18 changes, except if the value that is entered comes from a paste(not sure why) but if you use the Intersect method then it works even if the value came from a copy paste.
I did some small tweeks to your code and I think it works now. please review it and give it a try.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, ThisWorkbook.Sheets("Account Input").Range("B18")) Is Nothing Then
Call CountLoc
End If
End Sub
Public Sub CountLoc()
Dim LocCount As Long
Dim WsInput As Worksheet
Dim i As Long
Dim rng As Range
Set WsInput = Sheets("Account Input")
With WsInput
LocCount = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
If LocCount > 35 Then
Set rng = WsInput.Range(WsInput.Cells(18, 2), WsInput.Cells(LocCount, 19))
With rng
.Interior.Color = RGB(220, 230, 241)
.Borders.LineStyle = xlContinuous
.Borders.Color = vbBlack
.Borders.Weight = xlThin
End With
For i = 18 To LocCount Step 2
Set rng = WsInput.Range(WsInput.Cells(i, 2), WsInput.Cells(i, 19))
rng.Interior.Color = vbWhite
Next i
Else
Exit Sub
End If
End Sub
I have a very large set of data that includes start and stop times for aircraft in the NAS. I want to create a macro to make a visual representation of this data in excel, like the following:
(note: this image uses fake data)
As you can see I've done the first 7 rows by hand, but there are several data files with as many as 2500+ rows each which makes the process tedious. I've tried to create a macro but I'm confused how to search for and select the appropriate range to highlight.
Here's what I have so far:
Sub autofill()
Dim rng As Range
Dim row As Range
Dim cell As Range
'set the range of the whole search area
Set rng = Range("A2:HJ121")
For Each row In rng.Rows
Dim callsign As Variant
Set callsign = cell("contents", "A" & row)
Dim valstart As Variant
Set valstart = cell("contents", "E" & row)
Dim valstop As Variant
Set valstop = cell("contents", "F" & row)
'now select the range beginning from the column whose header matches the
'time in valstart and ends at the time which matches the time in valstop
Selection.Merge
Selection.Style = "Highlight"
Selection.Value = callsign
Next row
End Sub
What's the easiest way of selecting the rows I need?
I'm not a programmer by profession; apologies in advance if my code demonstrates sloppy technique or violates some holy programming principles. :P
Thanks!
Here's my go at VBA for this.
Option Explicit
Public Sub fillSchedule()
Dim startCol As Long
Dim endCol As Long
Dim i As Long
Dim j As Long
Dim ws As Excel.Worksheet
Dim entryTime As Single
Dim exitTime As Single
Dim formatRange As Excel.Range
Set ws = ActiveSheet
startCol = ws.Range("H:H").Column
endCol = ws.Range("HJ:HJ").Column
Call clearFormats
For i = 2 To ws.Cells(1, 1).End(xlDown).Row
entryTime = ws.Cells(i, 5).Value
exitTime = ws.Cells(i, 6).Value
Set formatRange = Nothing
For j = startCol To endCol
If (ws.Cells(1, j).Value > exitTime) Then
Exit For
End If
If ((entryTime < ws.Cells(1, j).Value) And (ws.Cells(1, j).Value < exitTime)) Then
If (formatRange Is Nothing) Then
Set formatRange = ws.Cells(i, j)
Else
Set formatRange = formatRange.Resize(, formatRange.Columns.Count + 1)
End If
End If
Next j
If (Not formatRange Is Nothing) Then
Call formatTheRange(formatRange, ws.Cells(i, "A").Value)
End If
Next i
End Sub
Private Sub clearFormats()
With ActiveSheet.Range("H2:HJ121")
.clearFormats
.ClearContents
End With
End Sub
Private Sub formatTheRange(ByRef r As Excel.Range, ByRef callsign As String)
r.HorizontalAlignment = xlCenter
r.Merge
r.Value = callsign
' Apply color
With r.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
' Apply borders
With r.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With r.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With r.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With r.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
How about a conditional formatting solution?
Highlight all the cells from H2 to (last bottom right cell).
Use this formula:
=IF(AND((H$1>$E2),(H$1<$F2)),TRUE)
Then apply a fill. And if you're willing to give up the border and the name inside the filled range, it will work for you :).
Also, you may want to Freeze Panes from G2 so you can scroll all the way to the HJ column and still see the Callsign column.
Hope this helps