I'm creating macro Excel that will check if there is empty cells in specific range before closing the Workbook. I have an issue that the range is dynamic , and I have cell that contain the range that I want to check each time, how can I use cell value inside VBA as range.
and this is the VBA
Private Sub Workbook_BeforeClose(Cancel As Boolean)
For Each cell In Range("A2:E2")
If cell.Value = "" Then
MsgBox "Please, fill empty cells", vbInformation, "Warning"
cell.Select
Cancel = True
Exit Sub
End If
Next
End Sub
Private Sub Workbook_Open()
End Sub
thank you
Try this code
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim e, cell As Range
e = Range("O11").Value
If IsNumeric(Evaluate("SUM(" & e & ")")) And Not IsNumeric(e) Then
For Each cell In Range(e)
If cell.Value = "" Then
MsgBox "Please, Fill Empty Cells", vbInformation, "Warning"
cell.Select
Cancel = True: Exit Sub
End If
Next cell
End If
End Sub
Related
I want to prevent copy pasting data in excel if the data is not unique. Im using the following macro.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedCells As Range
Dim Cell As Range
Set AffectedCells = Intersect(Target, Target.Parent.Range("A:A"))
If Not AffectedCells Is Nothing Then
For Each Cell In AffectedCells
If CountIf(Range("A:A"),A1) >2 Then
MsgBox "The data """ & Cell.Value & """ inserted in " & Cell.Address & " in column A is duplicste. We undo!", vbCritical Application.Undo 'undo insert
Exit Sub
End If
Next Cell
End If
End Sub
It is still allowing the data to be pasted.
I tried letting excel not save itself if the value is duplicate but it is still saving.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim rngCell As Range
Dim lngLstRow As Long lngLstRow = Sheet1.UsedRange.Rows.Count
For Each rngCell In Sheet1.Range("A1:A" & lngLstRow)
If CountIf(Range("A:A"),A1) > 2 Then
MsgBox "Please enter unique value " & rngCell.Address
rngCell.Select
End If
Next
End Sub
Unfortunately Worksheet_change is not working for me. I am using a Sheet where the first column is NOW() function. If I click anywhere in the excel the time on this cell changes, but the Worksheet_Change just don't detect it.
A2 is using =NOW()
Anyone knows how to fix this issue? I have tried several different ways and no one works.
'Option Explicit
'Option Base 1
Dim xVal As Double
'Update by Extendoffice 2018/8/22
'Private Sub Worksheet_Calculate(ByVal Target As Range)
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = Range("$A$2").Address Then
'Rows(3).Insert Shift:=xlDown
'Range("$A$3").Value = Now
'Range("$B$3").Value = xVal
'Range("$C$3").Value = Range("$C$2").Value
'Else
If xVal <> Range("$B$2").Value Then
Debug.Print xVal & " <- xVal IF"
Debug.Print Range("B2").Text & "<- Text IF"
Rows(3).Insert Shift:=xlDown
Range("$A$3").Value = Now
Range("$B$3").Value = xVal
Range("$C$3").Value = Range("$C$2").Value
End If
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
xVal = Range("$B$2").Value
End Sub
A Worksheet_Calculate Event Study
Google Drive
Cell A2 in worksheet Sheet1 contains the formula =B2.
Sheet1
Option Explicit
Private Sub Worksheet_Calculate()
WsCalc
End Sub
' Only to trigger the calculate event when different cell is selected.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ThisWorkbook.Worksheets("Sheet1").Range("B2") = Int(Rnd() * 2 + 1)
End Sub
ThisWorkbook
Option Explicit
Private Sub Workbook_Open()
WsCalc
End Sub
Module1
Option Explicit
Public lngSource As Long ' Current Source Value
Sub WsCalc()
Dim rngSource As Range ' Source Cell Range
' Create a reference to Source Cell Range (rngSource).
Set rngSource = ThisWorkbook.Worksheets("Sheet1").Range("A2")
' When the workbook opens, Current Source Valuec (lngSource) is equal to "".
' Therefore:
If lngSource = 0 Then
' Initialize Current Source Value (lngSource) i.e. write value
' of Source Cell Range (rngSource) to Current Source Value (lngSource).
lngSource = rngSource.Value
MsgBox "Monitoring started (lngSource=" & lngSource & ")."
Exit Sub
End If
' If you need disabling events, this is how you implement it. Not needed
' in this code.
' Application.EnableEvents = False
On Error GoTo ProgramError
' Check value of Source Cell Range (rngSource)
' against Current Source Value (lngSource).
If rngSource.Value <> lngSource Then
' The value has changed.
MsgBox "The value has changed from '" & lngSource & "' to '" _
& rngSource.Value & "'."
lngSource = rngSource.Value
Else
' The value hasn't changed (usually no code).
MsgBox "Value NOT changed, still '" & lngSource & "'"
End If
SafeExit:
' MsgBox "Enabling events before exiting."
' Application.EnableEvents = True
Exit Sub
ProgramError:
' Improve this error handling.
MsgBox "An unexpected error occurred."
On Error GoTo 0
GoTo SafeExit
End Sub
I need users to be able to fill in one row to generate a P.O., and when the P.O. is generated the row below would be unhidden. The P.O. depends on column C, E and G to be filled in.
This code only unhides a row if one of the requirements are met. It also makes the workbook lag.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Row < 14 Or Target.Row > 5000 Or Target.Column < 3 Or Target.Column < 5 Or Target.Column <> 7 Then GoTo ExitMe
Rows(Target.Row + 1).Hidden = False
ExitMe:
Application.EnableEvents = True
End Sub
I need one row to be filled in at a time so the P.O. can be generated properly. If there is a better way please let me know.
This macro also conflicts with my macro for protecting changed cells when the worksheet is saved. This is the error that appears: Run-time error '1004': Unable to set hidden property of the Range class.
It is placed in ThisWorkbook
Option Explicit
Private bRangeEdited As Boolean
Private WithEvents ws As Worksheet
Private Sub Workbook_Open()
Set ws = Range("A14:Y3000").Parent
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sMSG As String
sMSG = "saving the workbook will lock the cells you have entered data into." & vbLf
sMSG = sMSG & "Do you want to go ahead ?"
If Not bRangeEdited Then GoTo Xit
If Not Me.ReadOnly Then
With Range("A14:Y3000")
If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
Cancel = True
GoTo Xit
End If
.Parent.Unprotect "password"
If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
.SpecialCells(xlCellTypeConstants).Locked = True
bRangeEdited = False
End If
.Parent.Protect "password"
End With
End If
Xit:
End Sub
Private Sub ws_Change(ByVal Target As Range)
If Not Intersect(Range("A14:Y3000"), Target) Is Nothing Then
bRangeEdited = True
End If
End Sub
Apologies if this is simple, but I am new to VBA. I am attempting to set up the my Excel sheet so that when certain cells in the first sheet are changed (eg A1, A2, A3, A4) the names of four other sheets will change to match them. I have found the following formula which works if I change the specific cell on that sheet;
`
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Set Target = Range("A1")
If Target = "" Then Exit Sub
On Error GoTo Badname
ActiveSheet.Name = Left(Target, 31)
Exit Sub
Badname:
MsgBox "Please revise the entry in A1." & Chr(13) _
& "It appears to contain one or more " & Chr(13) _
& "illegal characters." & Chr(13)
Range("A1").Activate
End Sub
` Unfortunately it will not work if I change A1 to be dependent on one of the four cells on the main sheet specified previously, as it only looks for changes in the sheet it is saved in.
Is there a way to use VBA to look at a cell in one sheet and then change the sheet name of another sheet to match?
Thanks
Like I mentioned in the comments, it's not that simple to rename the sheet. You have to check for so many things.
My Assumptions
You have 5 Sheets in a workbook; Sheet1, Sheet2, Sheet3, Sheet4 and Sheet5
When you change cells in Sheet5, depending on the cell which changes, Sheets1-4's names are changed
I am assuming that when A1 changes, Sheet1 is renamed. When A2 changes, Sheet2 is renamed and so on...
Logic
Use Worksheet_Change event to trap changes to cell A1, A2, A3 or A4
Use Sheet CodeName to change the name
Check if the sheet name is valid. A sheet name cannot contain any of these Characters \ / * ? [ ]
Check if you already have a sheet with the name you want to use for renaming
If everything is hunky dory then go ahead and replace
Code
See this example. This code goes in the Sheet5 code area.
Dim sMsg As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsName As String
On Error GoTo Whoa
sMsg = "Success"
Application.EnableEvents = False
If Not Target.Cells.CountLarge > 1 Then
If Not Intersect(Target, Range("A1")) Is Nothing Then
wsName = Left(Target, 31)
RenameSheet [Sheet1], wsName
ElseIf Not Intersect(Target, Range("A2")) Is Nothing Then
wsName = Left(Target, 31)
RenameSheet [Sheet2], wsName
ElseIf Not Intersect(Target, Range("A3")) Is Nothing Then
wsName = Left(Target, 31)
RenameSheet [Sheet3], wsName
ElseIf Not Intersect(Target, Range("A4")) Is Nothing Then
wsName = Left(Target, 31)
RenameSheet [Sheet4], wsName
End If
End If
MsgBox sMsg
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
'~~> Procedure actually renames the sheet
Sub RenameSheet(ws As Worksheet, sName As String)
If IsNameValid(sName) Then
If sheetExists(sName) = False Then
ws.Name = sName
Else
sMsg = "Sheet Name already exists. Please check the data"
End If
Else
sMsg = "Invalid sheet name"
End If
End Sub
'~~> Check if sheet name is valid
Function IsNameValid(sWsn As String) As Boolean
IsNameValid = True
'~~> A sheet name cannot contain any of these Characters \ / * ? [ ]
For i = 1 To Len(sWsn)
Select Case Mid(sWsn, i, 1)
Case "\", "/", "*", "?", "[", "]"
IsNameValid = False
Exit For
End Select
Next
End Function
'~~> Check if the sheet exists
Function sheetExists(sWsn As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sWsn)
On Error GoTo 0
If Not ws Is Nothing Then sheetExists = True
End Function
Screenshot
The situation is simple, if I name cell A1 to be MY_CELL and then CUT AND PASTE from cell A2 to cell MY_CELL, then MY_CELL will lose that name and be named A1 again.
However, this does not happen when I COPY AND PASTE from A2 to MY_CELL.
How can I prevent Excel from resetting cell names on CUT AND PASTE?
Logic: Trap the changes to Cell A1 using the Worksheet_Change event and recreate the name if it is lost.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DoesRngNameExists As Boolean
Dim sName As String
On Error GoTo Whoa
Application.EnableEvents = False
'~~> You named range
sName = "MY_CELL"
If Not Intersect(Target, Range("A1")) Is Nothing Then
'~~> Check if the Range exists
On Error Resume Next
DoesRngNameExists = Len(Names(sName).Name) <> 0
On Error GoTo 0
'~~> If not then recreate it
If DoesRngNameExists = False Then _
ThisWorkbook.Names.Add Name:=sName, RefersToR1C1:="=Sheet1!R1C1"
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Note: The codes in the Sheet code area of the relevant sheet. See screenshot below.