I have a workbook that gathers data through SQL queries from a database that displays on a website. The queries gather data that is present and displays in a table which provide URL and time posted (these are columns: URL and Time), with this information I have a cell (B25 B28 and others), which uses a =countif formula to gather all the items that are in the table and which ones are past a certain time.
Example:
=COUNTIFS(table_name[URL Column Name],"Items underneath said Column",table_name[Time Column],">"&NOW()-0.167)
I'm trying to create a VBA script in the worksheet that has this information, launch the URL provided from the cell this formula reads, or display a list if there are more than 1 item over the allotted time. Ultimately I need a message box to display the URL.
So far, I have this as my VBA code:
Private Sub Worksheet_Calculate()
Dim lResponse As Long
Set ie = CreateObject("InternetExplorer.Application")
Application.EnableEvents = False
If Me.Range("D25, D28, D31, D34, D37").Value > 0 Then
lResponse = MsgBox("my message for yes or no?", vbQuestion + vbYesNo, "box title")
If lResponse = vbYes Then
ie.Navigate(" & Me.Range &").Value
Else
Exit Sub
End If
End If
Application.EnableEvents = True
End Sub
Thanks in Advance.
Try this, I don't know if it will help but there is.
MyVariable = Range("D25, D28, D31, D34, D37")
for each Mycell in MyVariable
if MyCell.Value > 0 then
..... 'your code
next Mycelll
Related
I created a couple of user forms which operate a data in separate report workbook. My script can successfully proceed a value in digit type. Unfortunately the circumstances have changed and now it has to work with a Serial Numbers as: 29160012040000TZ. With that new value script after starting the Sub, open a report, but it never enter into a 'with' statement. It doesn't look for a value or doing something else. Just open a report workbook and freeze.
Below you can see the code lines where issue is present and a little description:
Single_PHA is a text window in User Form where user can enter a a value, proceeding value is 29160012040000TZ
Private Sub Wydaj_button_Click()
Workbooks.Open Filename:="N:\ENGINEERING\1. ENGINEERS\Mateusz Skorupka\PHA_Cleaning_report_path\PHA_CLEANING_REPORT.xlsm", ReadOnly:=False
Dim REPORT As Workbook
Set REPORT = Application.Workbooks("PHA_CLEANING_REPORT.xlsm")
Set TABLE = REPORT.Worksheets("Main_table")
...
With TABLE.Range("A1")
If Single_PHA = True Then
If Not IsError(Application.Match(Single_PHA.Value, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA.Value, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
In VBA I don't know how to open something like debugger or make the print instruction which would show me how the variables look on specific steps.
I am not sure if VBA read the value as 29160012040000TZ as string. I tried to declare at the beginning a variable as Single_PHA_STR as String and the proceed it as just text, but no wins there:
Dim Single_PHA_STR As String
...
With TABLE.Range("A1")
If Single_PHA = True Then
Single_PHA_STR = Str(Single_PHA.Value)
If Not IsError(Application.Match(Single_PHA_STR, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA_STR, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
I noticed that if in VBA IDE I write a bold value 29160012040000TZ, I get an error
Expected line number or label or statement or end of statement
and the value is highlighted in red.
Could someone help me in that field and explain the nature of issues:
To reproduce a situation you can create a simply user form with one TextBox and one CommandButton. In the same worksheet as user form in a column A put a values: 29160012040000 and 29160012042027IR
Then make a sub which execute after double click on command button with code:
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A1")
If Text_box1 = True Then
If Not IsError(Application.Match(Text_box1.Value, .Range("A:A"), 0)) Then
Text_box1_row = Worksheets("Sheet1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlValues).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
End If
End With
End Sub
Then try to input in a UserForm's TextBox a value = 29160012040000 and you will see that script successfully filled a forth column in row with current date. Then try to input a value 29160012042027IR and you will see that nothing happened. Script don't proceed that value at all.
So that is my issue and question indeed. How to process a value with letters at the end like: 29160012042027IR : )
I also tried to focus a script statement on one specific cell in which is a text value "29160012042027IR" that which I input into a UserForm TextBox. Looking with a debugger both of variables in if statement have the same text value, but still script miss that statement and go to else instructions : (
I mean abut: If Range("A3").Text = Text_box1.Text Then
When I change a statement for "If Range("A3").Value = Text_box1.Value Then" the same thing happen.
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A:A")
If Text_box1 = True Then
If Range("A3").Text = Text_box1.Text Then
Text_box1_row = Worksheets("Arkusz1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlWhole).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
Else
MsgBox "Other loop"
End If
End With
End Sub
IMPORTANT NOTICE:
I found the main issue. I made wrong if condition, it should be:
If Single_PHA <> "" Then previously I have got: If Single_PHA = True Then, and there the results is a value not the boolean type.
Everything works. Thank everyone very much for help.
Topic is ready to be closed.
PS: thank you Tom for suggestion and tip with debugger: )
I am working on simple excel application for multiple users who will enter the data during different stages of the process. Unfortunately I met the problems with storage the data from multiple userforms in one row of the table.
I will try to explain what is the whole thing about as clear as I can.
For example purposes I called the application "Movie Time Control". Let's imagine that it is a tool for controlling the movies watched with focus on:
when the movie started,
if there were some breaks during displaying (and why)
when the movie has been restarted (how long the break took, and how many breaks there were and what actions were taken to continue),
in case when the movie was aborted, when, and why?
when the movie ended.
The MENU of application segment will look as on the screenshot below:
For each button different userform is assigned. The data entered in each form should be stored in one row in specific sheet.
Functionality of the userforms:
MOVIE START: Creating the entry in the table with movie title, date and time when its started.
MOVIE BREAK: Based on the movie title previously defined, filling out the date and time, reason of break (from the drop-down list or text box if not standard). The function can be used up to three times (three breaks).
MOVIE RESTART: If the break occurred, filling out the information about the date, time when movie was restarted, and what action has been taken in order to deal with the previously defined reason of break. For each break (possible three) function can be used.
MOVIE ABORT When (date and time) movie has been aborted (without intention to continue).
MOVIE FINISHED When (date and time) movie ended.
Where the problems occurred (questions):
When the data from the first row are entered, the entry with the specific title is created in the table separate sheet. Based on this entry, Title Combobox in all other userforms should list the titles which were started but not finished or aborted - just to quickly choose the "open title" and fill out other information related to the title. How to create a macro to list the "open cases" in the combobox?
I couldn't find out how to transfer the rest of the data to the same row of the table but different columns from all the forms after creating the entry with the specific movie title. Important thing is that the data can be added only to row with corresponding title (chosen from combobox from first question). Could you help me with the macro?
Macros I created until now (I am very beginner with VBA, thanks for understanding):
MOVIE START: For creating the entry with movie title.
Private Sub movie_start_save_Click()
If MsgBox("ARE YOU SURE?", vbYesNo, "Please confirm") = vbYes Then
Dim emptyRow As Long
'Make Sheet2 active
Sheet2.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information
Cells(emptyRow, 1).Value = Movie_Title_Box.Value
Cells(emptyRow, 2).Value = Start_Date_Box.Value
Cells(emptyRow, 3).Value = Start_Time_Box.Value
'Closing the form
Unload Me
'Back to MENU
Sheet1.Select
End If
End Sub
Private Sub movie_start_cancel_Click()
Unload Me
End Sub
MOVIE BREAK: For defining the time and reason (cannot transfer the data):
Private Sub UserForm_Initialize()
'Fill ReasonComboBox
With ReasonComboBox
.AddItem "Tea"
.AddItem "Coffee"
.AddItem "Popcorn"
.AddItem "Dinner"
.AddItem "Not standard"
End With
'Default text in the reason box
ReasonTextBox.ForeColor = &HC0C0C0 '<~~ Grey Color
ReasonTextBox.Text = "In case of 'not standard' reason leave your comment here"
movie_break_cancel.SetFocus '<~~ This is required so that the focus moves from TB
End Sub
'Default text in the reason box - disapearing when you want to edit
Private Sub ReasonTextBox_Enter()
With ReasonTextBox
If .Text = "In case of 'not standard' reason leave your comment here" Then
.ForeColor = &H80000008 '<~ Black Color
.Text = ""
End If
End With
End Sub
'Default text in the reason box - somehow disappearing for good, but ok
Private Sub ReasonTextBox_AfterUpdate()
With ReasonTextBox
If .Text = "" Then
.ForeColor = &H80000008
.Text = ""
End If
End With
End Sub
'Cancel Button
Private Sub movie_break_cancel_Click()
Unload Me
End Sub
The rest is actually similar with a few differences.
Link to download the excel file:
https://drive.google.com/file/d/0BxFSL2h-9qflQjRzNTQ2ZlhJNjA/view?usp=sharing
Hopefully I expressed myself clear enough to understand this.
Greetings!
In my example below, I show how to configure a ComboBox to hold multiple columns of data and to later retrieve the values. This will allow you to store the Row number along with the movie data in the ComboBox.
'Filtering for not finished jobs for combobox
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim x As Long
With Me.Movie_Title_ComboBox
.ColumnCount = 4
.ColumnWidths = "0 pt;250 pt;90 pt; 90 pt;"
'.ListWidth = 500
.TextColumn = 2
.BoundColumn = 1
End With
Set ws = Sheet2
With ws
For x = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
If .Cells(x, 4).Value = "" Then
AddItems Me.Movie_Title_ComboBox, x, .Cells(x, 1).Value, Format(.Cells(x, 3).Value, "MM/DD/YYYY"), Format(.Cells(x, 3).Value, "HH:MM")
End If
Next
End With
End Sub
Private Sub Movie_Title_ComboBox_Change()
With Me.Movie_Title_ComboBox
If .ListIndex > -1 Then
Finish_Date_Box.Value = .List(.ListIndex, 2)
End If
End With
End Sub
Private Sub movie_finished_save_Click()
With Sheet2
.Cells(Me.Movie_Title_ComboBox.Value, 4) = Me.Finish_Date_Box.Value
.Cells(Me.Movie_Title_ComboBox.Value, 5) = Me.Start_Time_Box.Value
End With
End Sub
Add this function to a Public Code Module so that it will be available to all your userforms.
Sub AddItems(oComboBox As MSForms.ComboBox, ParamArray Items() As Variant)
Dim x As Long
With oComboBox
.AddItem Items(0)
For x = 1 To UBound(Items)
.List(.ListCount - 1, x) = Items(x)
Next
End With
End Sub
I think I need to try and make this question easier. So here goes;
I am creating a User form in Excel that will act as a data capture form.
In this form I have a Textbox called PolBX In this a is placed and at submission data in PolBX is copied into the "G" column using this code
Cells(emptyRow, 7).Value = PolBX.Value. This works great.
I discovered that there may be instances where the User may accidently use the same Unique Id number twice. so I am trying to find out how to code it that after the User has entered the Unique Id number it would check for that string (Consists of letters and numbers). if it finds the string already in the 7th column(G) it must say something like
"Policy number already Used, please try again"
I am thinking I will need to use the following subroutine
Private Sub PolBX_AfterUpdate()
End Sub
Can some please assist with creating this code...
Also can you please explain what you are doing as I started VBA about a week ago
You can add the following code to search for your policy number, and if nothing found then PolLookup = Nothing.
Option Explicit
Sub Test()
On Error GoTo ErrHandler
Dim ws As Worksheet, PolLookup As Range, LookupRng As Range
Set ws = ThisWorkbook.Worksheets(1)
'This is the range you want to search, it can be a long range
'or it can be a single cell.
Set LookupRng = ws.Range("A:A")
'Range.Find is looking for your value in the range you specified above
Set PolLookup = LookupRng.Find("YourLookupValue")
'PolLookup = Nothing if it didn't find a match, so we want to use
'If <NOT> Nothing, because this suggests .Find found your value
If Not PolLookup Is Nothing Then
Err.Raise vbObjectError + 0 'Whatever error you want to throw for finding a match
End If
'Exit before you reach the ErrHandler
Exit Sub
ErrHandler:
If Err.Number = vbObjectError + 0 Then
'Handle your error. Do you want to stop completely? Or have the
'User enter a new value?
End If
End Sub
Basically, after your user enters their value in your UserForm, just make a call to this Sub to do a quick lookup.
Playing around I discovered a Much easier way! I included a Button with he following code attached
Private Sub CommandButton8_Click()
Search = PolBX.Text
Set FoundCell = Worksheets("sheet1").Columns(7).Find(Search,LookIn:=xlValues, lookat:=xlWhole)
If FoundCell Is Nothing Then
MsgBox "No duplicates found"
Else
MsgBox "This policy has already been Assessed" & "Please assess a different case"
PolBX.Value = ""
End If
So I have been trying to put together a little Excel sheet, that has an entry Log in it. So whenever the sheet is closed, Name, Date and Time are added.
So basically I have three macro running, I will only mention two. The main macro will ask if I want to close the sheet and I will have to answer with yes or no. This works fine. If I press yes the main macro will call a sub macro, that will ask me to enter a string. If this Inputbox is empty or the entry is canceled, I want the main sub to stop running and cancel the Close process. Which won't seem to work. The error in the code to me seems pretty clear, but I don't know how to prevent it and find a better solution. If you could help me come up with a solution I would really appreciate it.
This line of code seems to be the problem:
If Cancel_Button_LOG = False Then Cancel = True
Here I will add compressed versions of the two macros
Public Sub Add_Entry_to_Log()
Dim i As Integer
Dim response As Variant
Cancel_Button_LOG = True
response = InputBox("Please enter your Name", "Name")
If response <> "" Then
Else
Cancel_Button_LOG = False
MsgBox "Please enter your name", vbExclamation + vbOKOnly, "Name"
End If
Worksheets("Log").Protect "secret"
ThisWorkbook.Save
End Sub
Now I will want to use the Cancel_Button_log Variable to cancel the main sub:
Dim answer As Variant
answer = MsgBox("Are your sure you want to close the workbook?", vbYesNo) Cancel = False
Select Case answer
Case Is = vbYes
Worksheets("Log").Unprotect "secret"
Call Test
Call Add_Entry_to_Log
If Cancel_Button_LOG = False Then Cancel = True
Worksheets("Log").Protect "secret"
Case Is = vbNo
Cancel = True
End Select
ThisWorkbook.Save
End Sub
I think you're doing this in the most complicated way possible. If I understand your requirements correctly - you can replace all your code in your ThisWorkbook module with something like this:
Const WB_LOG As String = "Log" '// name of sheet that the log is in
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("Do you really want to close the workbook?", vbYesNo) = vbYes Then
With Sheets(WB_LOG)
.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 2).Value = Array(Environ$("USERNAME"), Now)
End With
ThisWorkbook.Save
Else
Cancel = True
End If
End Sub
Private Sub Workbook_Open()
With Sheets(WB_LOG)
.Protect Password:="secret", UserInterfaceOnly:=True
.Range("A1:B1").Value = Array("USERNAME", "TIMESTAMP")
End With
End Sub
This would negate the need for the user to manually insert their name (assuming their system username would suffice*) and also negate the need to unprotect the worksheet each time as I've used the UserInterfaceOnly option.
* Environment variables such as %USERNAME% can be falsified if a user wishes to do so and knows how - however someone typing their name into a textbox is even easier to falsify...
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