I am fairly new to VBA so I was wondering if somebody can give a helping hand on something that I have been working on. It is a fairly simple concept and I believe that most of it is done apart from one functionality I can't seem to get to work.
So far, I have created a bookmark functionality in which the current selected cell or cells is highlighted and name the range as 'bookmark' the first time the VBA script is invoked. By using the VBA script the second time around the user is taken from the previously highlighted cell and the range name as well as the highlight is deleted. However, this functionality only works on one workbook and the corresponding sheets within it.
I would like to be able to use this functionality to all currently opened workbooks or perhaps all excel document within a specific folder. My code is as follows:
Sub setBookmark()
Dim rRangeCheck As Range
Dim myName As Name
On Error Resume Next
Set rRangeCheck = Range("bookmark")
On Error GoTo 0
If rRangeCheck Is Nothing Then
ThisWorkbook.Names.Add "bookmark", Selection
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
Application.Goto Range("bookmark")
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
For Each myName In ThisWorkbook.Names
If myName.NameLocal = "bookmark" Then myName.Delete
Next
End If
End Sub
Modify like that:
Dim rRangeCheck
Dim myName As Name
On Error Resume Next
rRangeCheck = ""
rRangeCheck = Application.Names("bookmark")
On Error GoTo 0
If rRangeCheck = "" Then
ActiveWorkbook.Names.Add "bookmark", Selection
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
Application.Goto Range("bookmark")
Application.Goto Range("bookmark")
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
For Each myName In ActiveWorkbook.Names
If myName.NameLocal = "bookmark" Then myName.Delete
Next
End If
The double Applicatio.Goto it's to have the selection of Workbook + the Sheets and the cell...
If you remove, only the workbook it's selected.
Related
My goal is to copy rows from Sheet("VBA") to a specific location in Sheet("COLUMBIA-TAKEDOWN"). The location is Offset(1,1) of the cell containing "P R O S P E C T S". The first part of my code works well enough however my problems begin with selecting and editing a row [Prospect.Offset(13,-1).Select]. It appears to be ignoring this line of code because the formatting lines that follow are not happening. It's not throwing out an error message.
I understand that I'm incorrectly selecting the row and therefore unable to make the formatting changes but I don't know how to correct this problem.
Application.ScreenUpdating = False
Dim Prospect As Range
Set Prospect = Sheets("COLUMBIA-TAKEDOWN").Cells.Find(what:="P R O S P E C T S")
Sheets("VBA").Visible = True
Sheets("VBA").Rows("13:25").Copy
Prospect.Offset(1, -1).Insert shift:=xlDown
Prospect.Offset(13, -1).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Prospects.Offset(1, -1).Select
Sheets("VBA").Visible = False
End Sub
The problem is that you are trying to insert rows in a cell range... they are not the same size, hence the error.
Give this a try... might need some more thinkering, but i`ve just reused your code.
Sub test()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook
Dim sht As Worksheet: Set sht = wb.Sheets("Sheet1")
Dim ProspectRow As Long: ProspectRow = sht.Cells.Find(what:="P R O S P E C T S").Row + 1
wb.Sheets("VBA").Rows("13:25").Copy
sht.Rows(ProspectRow).Insert Shift:=xlDown
With sht.Rows(ProspectRow + 13).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Application.ScreenUpdating = True
End Sub
EDIT: revamped the code for critics...
EDIT2: added the formatting...
I'm using Excel version 16.24 for Mac, and I did some recording of Macros to format the worksheets followed by a loop to all the other worksheets.
However, there are 2 issues I am facing at the moment.
Issue 1: If an imported sheet is blank, there will be an error as I do not know how to create a skip to the next sheet. I have to remember to delete the sheet for the code to run without errors.
Issue 2: As I run the "FormatAllSheets" code, it only expands to a restricted area as it's recorded with data I have. In the case of the following month's data, it will not format it as there is a limitation. from the recording.
Below is the code I am using currently recorded step-by-step based on only existing data, I need to have it useable for future data as well.
Sub FormatSheet()
Cells.Select
Selection.AutoFilter
Cells.EntireColumn.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Selection.Font.Size = 14
Selection.Font.Bold = True
Range("A2").Select
End Sub
Sub FormatAllSheets()
Dim i As Integer
i = 2
Do While i <= Worksheets.Count
Worksheets(i).Select
FormatSheet
i = i + 1
Loop
End Sub
The above work as expected but I need to improve it to make it more seamless and responsive.
All help will be very much appreciated. I'm still new to this so pardon me for asking too many silly questions. Thank you.
Your first issue needs a check to see if any data in cell and then skip if not.
Your second issue you need to find the last used column and then you can use the range and the column number to format. Note there is no need to use selection or select as it's slows down performance. I think it will be best to use .UsedRange and just format only the cells that actually have data.
Sub FormatSheet()
Dim lrow as long
Dim ws as ActiveSheet
Cells.Select
Selection.AutoFilter
Cells.EntireColumn.AutoFit
Set ws = ActiveSheet
With ws
lrow = .Range("A" & .Columns.Count).End(xlToRight).Column
End With
With Range("A" & lrow).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Selection.Font.Size = 14
Selection.Font.Bold = True
End Sub
Sub FormatAllSheets()
Dim i As Integer
i = 2
Do While i <= Worksheets.Count
Worksheets(i).Select
if Len(Trim(.Range("A1").value)) > 0 then '->change range where data is
FormatSheet
i = i + 1
else
i = i + 1
Loop
End Sub
In this code I am trying to have the user select a range in a row. If the row contains "HOL" the message box show will show a message.
The way the code is right now when the user chooses one cell that contains "HOL" the message appears when the user chooses multi cells in a row an error Runtime error 13 appears. This is the if statement that I am having problems
I have tried different range select methods but I am not familiar enough with coding yet to understand my error.
' Highlight_SKL Macro
' This macro will highlight leave dates for entry
Dim rng As Range
Set rng = Range(Selection.Address)
If MsgBox("Are you sure you want to submit day of SKL", vbYesNo) = vbNo Then Exit Sub
If InStr(Range(Selection.Address), "HOL") Then MsgBox ("You are entering a SKL date on a Federal Holiday")
With Selection.Interior
rng = "=1"
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 250
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
When the user select a row that contains "HOL" a message box appears and lets them know.
Use a wildcard MATCH for a selection of one or many cells.
If Not IsError(application.match("*HOL*", Selection, 0)) Then _
MsgBox "You are entering a SKL date on a Federal Holiday"
The below code use for each loop to loop each cell of the selection to avoid errors.
Option Explicit
Sub test()
Dim rng As Range, cell As Range
Set rng = ThisWorkbook.Worksheets("Sheet1").Range(Selection.Address) '<- Change sheet name if need
If MsgBox("Are you sure you want to submit day of SKL", vbYesNo) = vbNo Then Exit Sub
For Each cell In rng
If InStr(cell, "HOL") Then MsgBox ("You are entering a SKL date on a Federal Holiday")
With cell
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 250
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Value = 1
End With
Next cell
End Sub
I'm trying to create a VBA script to highlight a particular range of cells when a user inputs any value in the cell. For example my cell range will be a1:a5, if a user enters any value in any cells within the range, cells a1 till a5 will be highlighted in the desired color. I'm a new user with VBA and after searching for a while found the below code that might be useful. Looking for advice. Thanks.
Private Sub Highlight_Condition(ByVal Target As Range)
Dim lastRow As Long
Dim cell As Range
Dim i As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Application.EnableEvents = False
For i = lastRow To 1 Step -1
If .Range("C" & i).Value = "" Then
Debug.Print "Checking Row: " & i
.Range("A" & i).Interior.ColorIndex = 39
.Range("F" & i & ":AW" & i).Interior.ColorIndex = 39
Next i
Application.EnableEvents = True
End With
End Sub
Edit: Trying to edit the code given by teylyn to be able to remove highlight from cells if cell value is removed however I can't seem to find the solution. (The original code will highlight the cells when there is input in cells however if you remove the cell value the highlight remains there.)
If Not Intersect(Target, Range("A12:F12")) Is Nothing Then
With Range("A12:F12").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ElseIf IsEmpty(Range("A12:F12").Value) = True Then
With Range("A12:F12").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65536
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
This code does what you describe, i.e. set a fill color for range A1 to A5 when any cell in that range is edited.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A5")) Is Nothing Then
With Range("A1:A5").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End Sub
This code needs to be put in the sheet module.
Edit: If you want the highlight to disappear if none of the five cells have a value, then you can try out this variant:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim valCount As Long
If Not Intersect(Target, Range("A1:A5")) Is Nothing Then
' a cell in Range A1 to A5 has been edited
' we don't know if that edit was adding or deleting a cell, so ...
' ... we count how many cells in that range contain values
valCount = WorksheetFunction.CountA(Range("A1:A5"))
If valCount > 0 Then
' the range has values, so highlight
With Range("A1:A5").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
' the range has no values, so remove the highlight
With Range("A1:A5").Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
End Sub
I have a cellrange (U4:U50) that allows you to choose between "yes" and "no". I want, for each row, format and protect the cells on the right (V4:AL4, V4:AL4, etc until V50:AL50) when relevant cell in column A changes value.
I am able to put together only a few pieces of the code based on my little knowledge: I managed to make the desired changes happen for the row 4, based on the code below.
The protect and UNprotect sub are in ThisWorkbook and they do exactly that.
Sub Worksheet_Change(ByVal Target As Range)
Set checkRange = Application.Intersect(Target, Range("U4:U50"))
' If the change wasn't in this range then we're done
If checkRange Is Nothing Then Exit Sub
If Range("U4").Value = "Yes" Then
Range("V4:AL4").Select
Call ActiveWorkbook.UNprotect_all_sheets
With Selection
.Locked = True
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark2
.TintAndShade = -9.99786370433668E-02
.PatternTintAndShade = 1
End With
Range("U4").Select
ElseIf Range("U4").Value <> "Yes" Then
Call ActiveWorkbook.UNprotect_all_sheets
Range("V4:AL4").Select
With Selection
.Locked = False
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Call ActiveWorkbook.Protect_all_sheets
End Sub
Next step is to make the code work for all the rows depending from the target range, so I started with this
Dim r As Long
Dim c As Long
' 21 targets column U
c = 21
For r = 4 To 50
If Cells(r, c).Value = "Yes" Then
'here I think the process would be to unprotect the sheet, then select from (r,c+1) to (r,c+17), apply the formatting (shade and protection), go to next r and at the end protect the sheet again
But my problem is that I do now know how to:
Select the range of cells from Cells(r,c+1) to Cells(r,c+17);
Make the instruction relative to the right row.
Any comment on that is more than welcome!!
Thanks to all of you in advance, I hope you can understand from my explication what I need to do.
I have been looking for the answer around, maybe I have not been able to look for the right wording..
You can do it this way. Generally there is no need to Select anything but I have left it in as it's not clear whether your other subs are working off a selection. You could use Resize but I can't be bothered to work out how many columns it is from V to AL.
On reflection, it's probably safe to reconfigure the first block as I have done in the second (and perhaps the unprotect should be called before the selecting in any case).
Strictly speaking the code should cater for multiple cells being changed. For this, you can change instances of Target to Target(1).
Sub Worksheet_Change(ByVal Target As Range)
Set checkRange = Application.Intersect(Target, Range("U4:U50"))
' If the change wasn't in this range then we're done
If checkRange Is Nothing Then Exit Sub
If Target.Value = "Yes" Then
Range(Cells(Target.Row, "V"), Cells(Target.Row, "AL")).Select
Call ActiveWorkbook.UNprotect_all_sheets
With Selection
.Locked = True
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark2
.TintAndShade = -9.99786370433668E-02
.PatternTintAndShade = 1
End With
End With
Else
Call ActiveWorkbook.UNprotect_all_sheets
With Range(Cells(Target.Row, "V"), Cells(Target.Row, "AL"))
.Locked = False
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
End If
Call ActiveWorkbook.Protect_all_sheets
End Sub