Hi I'm wondering what is the quickest (least memory using) way to check a range of data points to see if the points are valid.
Lets say I have a rng = Range("A1:A100"). I want to write something such that
If c in rng = "N/A Requesting Data..." Then
x = false
Else
Application.OnTime Now() + TimeValue("00:00:05"), "refresh" .... etc.
End if
Can i do this without looping?
This checks A1:A100 of the ActiveSheet. If no cells contain "N/A" as part of their text RangeLooksGood is set to True.
Sub TestRangeForValidContent()
Dim RangeLooksGood As Boolean
With ActiveSheet
RangeLooksGood = (Application.WorksheetFunction.CountIf(.Range("A1:A100"), "*N/A*") = 0)
End With
If RangeLooksGood Then
Application.OnTime Now() + TimeValue("00:00:05"), "refresh"
End If
End Sub
Related
Good afternoon. I have tried multiple methods now to achieve this. In essence the code works when I run it, however, it doesn't seem to do it when the Workbook opens as it should. Is there an easier way to achieve this?
Basically in rows 5-28 there are random strings, and I want cell G4 to show one of the random strings every time the workbook is opened.
I think I might be along the right lines, but am I missing anything obvious?
Many thanks
Private Sub Workbook_Open()
wbOpenEventRun = True
Dim MyValue
MyValue = Int((28 * Rnd) + 5)
Sheets("Hints & Tips").Range("G4") = Cells(MyValue, 7)
End Sub
Try this:
Private Sub Workbook_Open()
Randomize 'As Suggested by John Coleman
wbOpenEventRun = True
Dim ws As Worksheet
Set ws = Sheets("Hints & Tips")
ws.Range("G4").Value = ws.Range("G" & Int((23 * Rnd()) + 5)).Value
End Sub
You could use Application.WorksheetFunction.RandBetween():
Private Sub Workbook_Open()
wbOpenEventRun = True
Dim MyValue
MyValue = Application.WorksheetFunction.RandBetween(5,28)
Sheets("Hints & Tips").Range("G4") = Cells(MyValue, 7)
End Sub
You were trying to assign something to the Range object, not to the cell's value. Read the Value property of the source cell and write that to the Value property of the destination:
Sheets("Hints & Tips").Range("G4").Value = Sheets("SourceSheet").Cells(MyValue, 7).Value
It's best to also specify which sheet is the source of the data, or it will depend on which sheet is active at the time the macro runs - unless that's the behaviour you want.
This question already has answers here:
Determine whether user is adding or deleting rows
(7 answers)
Closed 6 years ago.
I was trying to figure out how to determine when a row (or column) is inserted or deleted in Excel using VBA during the Worksheet_Change event and came across the topic here. However, the suggested answers given there, didn't fully capture all instances when a row is inserted or deleted on a worksheet including:
While they capture instances of when ENTIRE rows are inserted or deleted, they don't capture instances where only a group of cells are inserted or deleted shifting cells below or above down or up.
While they capture instances of rows inserted or deleted within a USEDRANGE, they don't capture instances where you are inserting outside of the used range (e.g. inserting a row below where you have data entered).
Given the above statements, I searched for more options and could not find any. Then, I came up with my own solution which I'm providing here to help others. I'm also hoping at the same time to get feedback on any flaws or areas of improvement.
The below Excel VBA codes will determine whether or not a user has either inserted or deleted an entire row or group of cells (shifting cells up or down) all within or out of the used range.
Here's the code (could also be converted for columns as well):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells(Target.Row + Target.Rows.Count, Target.Item(1, 1).Column).ID = Target.Address
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Item(1, 1).ID <> "" Then
MsgBox "deleted row"
Else
MsgBox "inserted row"
End If
Target.Item(1, 1).ID = ""
Cells(Target.Row + Target.Rows.Count, Target.Item(1, 1).Column).ID = Target.Address
End Sub
It's very simple actually and uses cell tagging to keep track of what the user actions which you can then use to determine if an insert or delete occurred.
"Wait?!" You might say. "There's a way to tag cells?" Or... "What is cell tagging".
Well, there really isn't a "tag" property for a cell, but you can retrofit the "Cell.ID" property and use it as a tag for a cell. The "Cell.ID" property's original intent is to be used when saving the Excel file as a webform, but it works pretty as a tag as well if your not going to create webforms. The only downside is you cannot save it's value with the workbook when you close and save the file. But, that's okay for this because you don't need to save tag values anyway.
Anyway, I think it works well. But, please let me know if you see any areas for improvement or flaws.
Only issue I can think of if as you click around, it tags the cells continually and leaves a lot of left over trash lying around if you don't end up making a change to a cell. But, this is not saved when you close the workbook and only occurs while the file is open.
Ok I'm back. Still testing, but here is my status so far. It got more complicated because you have to keep track of an additional tag and clean-up after yourself. It's a matter of keeping track of what Excel does to the tagged cells (did they shift down, shift up, etc...). Once that pattern is figured out and fully trapped, then I think this should work. Fingers crossed.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call TagCellManager(Target)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CurCel As Range, CurRow As Range
Dim TagCel As Range, TagRow As Range
Dim NxtCel As Range, NxtRow As Range
Set CurCel = Target.Item(1, 1)
Set CurRow = Cells(CurCel.Row, 1)
Set TagCel = Cells(CurCel.Row + Target.Rows.Count, CurCel.Column)
Set TagRow = Cells(CurCel.Row + Target.Rows.Count, 1)
Set NxtCel = TagCel.Offset(Target.Rows.Count, 0)
Set NxtRow = TagRow.Offset(Target.Rows.Count, 0)
If TagCel.ID <> "" And TagRow.ID <> "" Then
'ignore me. i'm entering data
ElseIf NxtCel.ID <> "" Or NxtRow.ID <> "" Then
MsgBox "row inserted"
Set Target = Range(NxtCel.ID)
Call TagCellManager(Target)
ElseIf CurCel.ID <> "" Or CurRow.ID <> "" Then
MsgBox "row deleted"
Set Target = Range(CurCel.ID)
Call TagCellManager(Target)
End If
End Sub
Sub TagCellManager(Target As Range)
Dim CurCel As Range, CurRow As Range
Dim TagCel As Range, TagRow As Range
Dim NxtCel As Range, NxtRow As Range
Set CurCel = Target.Item(1, 1)
Set CurRow = Cells(CurCel.Row, 1)
Set TagCel = Cells(CurCel.Row + Target.Rows.Count, CurCel.Column)
Set TagRow = Cells(CurCel.Row + Target.Rows.Count, 1)
Set NxtCel = TagCel.Offset(Target.Rows.Count, 0)
Set NxtRow = TagRow.Offset(Target.Rows.Count, 0)
CurCel.ID = ""
CurRow.ID = ""
TagCel.ID = Target.Address
TagRow.ID = Target.Address
NxtCel.ID = ""
NxtRow.ID = ""
End Sub
avid reader, first time poster here. I have a Macro that I obtained from the internet for the most part, then made some adjustments. It's purpose is to color code cells that have passed a certain duration. It was working fine earlier, but now I am getting an error on it for a "Type Mismatch". The line that reads "This is where the error is" is where I am getting the mismatch. I am puzzled because it was working fine earlier. I am not a seasoned programmer by any means, but I just try to troubleshoot things. I have looked all over the net and cant find a specific answer to my question.
In addition, if any of you are willing, I would appreciate your advice on how to make this code run ONLY at startup of the workbook and NOT periodically as it is set up to do so now.This code is not placed in a worksheet, but in a Module.I mention this because I am not sure how much of a practical difference it can make any help is appreciated, thanks!
Public TimeToRun As Date
Sub Auto_Open()
Call ScheduleCompareTime
End Sub
Sub ScheduleCompareTime()
TimeToRun = Now + TimeValue("00:00:10")
Application.OnTime TimeToRun, "CompareTimeStamp"
End Sub
Sub CompareTimeStamp()
Dim rgTimeStamp As Range
Dim rdTimeStamp As Range
Dim i As Long
Dim j As Long
Dim MyNow As Date
Dim TimeStamp As Date, TimeStampp As Date
Set rgTimeStamp = Range("c1:c500")
Set rdTimeStamp = Range("H1:h500")
For i = 1 To rgTimeStamp.Rows.Count
If Not rgTimeStamp.Cells(i, 1) < 1 Then 'don't run for an empty cell
MyNow = CDate(Now - TimeSerial(0, 0, 0)) 'time instantly
TimeStamp = CDate(rgTimeStamp.Cells(i, 1)) 'THIS IS WHERE THE ERROR IS!!
If TimeStamp < MyNow Then 'if it's old at all
rgTimeStamp.Cells(i, 1).Interior.ColorIndex = 3 'make fill colour red
End If
End If
Next
For j = 1 To rdTimeStamp.Rows.Count
If Not rdTimeStamp.Cells(j, 1) < 1 Then
MyNow = CDate(Now - TimeSerial(0, 0, 0))
TimeStampp = CDate(rdTimeStamp.Cells(j, 1))
If TimeStampp < MyNow Then
rdTimeStamp.Cells(j, 1).Interior.ColorIndex = 3
End If
End If 'closes If Not
Next
Call ScheduleCompareTime 'begins the scheduler again
End Sub
Sub auto_close() 'turn the scheduler off so you can close workbook
Application.OnTime TimeToRun, "CompareTimeStamp", , False
End Sub
You probably have data in one or more cells that Excel cannot convert to a date. You can get around this by adding some simple checking such as this:
'.... beginning of your code
If Not rgTimeStamp.Cells(i, 1) < 1 Then 'don't run for an empty cell
MyNow = CDate(Now - TimeSerial(0, 0, 0)) 'time instantly
If IsDate(rgTimeStamp.Cells(i, 1)) = False Then
MsgBox "Invalid date found in cell " & rgTimeStamp.Cells(i, 1).Address(False, False)
Exit Sub
End If
TimeStamp = CDate(rgTimeStamp.Cells(i, 1)) 'THIS IS WHERE THE ERROR IS!!
If TimeStamp < MyNow Then 'if it's old at all
rgTimeStamp.Cells(i, 1).Interior.ColorIndex = 3 'make fill colour red
End If
End If
'... rest of your code
If you only want the code to run at startup then change Sub Auto_Open to this:
Sub Auto_Open()
Call CompareTimeStamp
End Sub
I have an Excel sheet in which I am accepting value from the user when user enter a value a VBA will run which check the data is valid or not and if the data is not valid it will prompt a message saying invalid data. Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$12" Or Target.Address = "$D$13" Or Target.Address = "$D$14" Or Target.Address = "$D$15" Then
Call Room
End If
End Sub
Room method is
Sub Room()
Dim lastRow As Long
If IsNumeric(Range("i17")) Then
If [I17] < 0 Then
MsgBox "msg "
End If
End If
End Sub
In I17 cell I have a formula
=C6-(D12+(2*D13) + (2*D14) + (3*D15))
My problem is when wrong data is enter in any of the cells (D12, D13, D14, D15) then the cell should be clear automatically after showing prompt message.
How can this be done?
The first thing that you should do is clean up how you check what Target is. It could be multiple cells (Fill Down, paste a range, ...). This is accomplished by intersecting Target with the range you are interested in, and We'll store into a range variable, for later. If there is no overlap, then intersect will return an empty object, which we can test for with is Nothing.
The next thing to note is that odd things (infinite recursion) can happen if we allow the Worksheet_Change event to fire by changing a cell. To prevent this, we will turn off events before calling Room, and turn it back on after we're done.
Next we pass the range that has changed into room, so we can modify it from within that subroutine.
And, finally we modify the affected range after displaying the message. Note that I have used a command to literally clear the cell. Since you are performing calculations based on that data, you might prefer to set it to default value, like 0, using a.value = 0 instead.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Range
Set a = Intersect(Target, Range("D12:D15"))
If Not a Is Nothing Then
Application.EnableEvents = False
Room a
Application.EnableEvents = True
End If
End Sub
Sub Room(a As Range)
Dim lastRow As Long
If IsNumeric(Range("I17")) Then
If Range("I17").Value < 0 Then
MsgBox "msg "
a.ClearContents
End If
End If
End Sub
As a side note, I have a used a bad variable name a, since I don't know what that range represents. You should pick something that describes to future maintainers what is going on.
use this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As Range
Set t = Intersect(Target, [D12:D15])
Application.EnableEvents = 0
If Not t Is Nothing Then
Call Room
If [I17] < 0 Then Target.Value = ""
End If
Application.EnableEvents = 1
End Sub
I am building a template/form in excel that will be used by different people on different computers to fill in some information and then send it by email to me.
When the template is being filled I need to assign an unique ID number to a field along with other info(kind of like a request ID). I am generating this unique ID by using
CONCATENATE("NER-";DEC2HEX(RANDBETWEEN(0;4294967295);8))
This formula serves me good for the task at hand.
My challenge is to evaluate this formula only one time in the template and then keep it the same when I open the file once it gets to me. Something along the lines of a time stamp. I have already looked into some methods but I cannot seem to get it to work.
I have tried making use of:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("A2:A10"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
But I do not know how to integrate my concatenate function into the code. I am also not extremely sure if this will keep my unique value untouched when I open the template on my computer.
I would guess that a method that would limit my iterations in the entire sheet would also serve me good.
You could generate and store the ID right when the user first opens the workbook/template, placing this code in the ' ThisWorbook module:
Private Sub Workbook_Open()
'ID already set?
If Sheet1.Range("A2").Value <> "" Then Exit Sub
'Prevent that ID is generated on your machine
If Environ$("Username") = "YOURUSERNAME" Then Exit Sub
'Store ID
Sheet1.Range("A2").Value = _
"NER-" & [DEC2HEX(RANDBETWEEN(0,4294967295),8)]
End Sub