I have this code where a msgbox pops up notifying a duplicate value.
Problem is the msgbox() does not go away on clicking ok and the code gets stuck.
Dim row As Integer
Dim counter As Integer
Range("c2").Activate
Application.ScreenUpdating = False
For counter = 0 To 688
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value And ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(1, 2).Value And ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(1, 3).Value And ActiveCell.Offset(0, 9).Value = ActiveCell.Offset(1, 9).Value Then
MsgBox ("Found a duplicate")
Else ActiveCell.Offset(1, 0).Activate
End If
Next counter
The problem is that when the If is True the MsgBox is displayed and ActiveCell is never incremented. Therefore the MsgBox gets re-displayed 687 times!
Related
I am new to VBA and I have a question. I have created a userform in excel. So, my question is that I want to enter values in the textbox and submit, the next time I launch the userform, it remembers the last entry in the userform. So, for example, I have textbox called facility. I enter in value UHN for the first time. Once I have closed the userform. Then I open the userform again, the value UHN is already filled in so the user does not need to type it again. So, the user form remembers the last entry in the textbox.
Thank you in advance!
My vba code is as follows:
Option Explicit
Private Sub AddlistButton_Click()
Dim emptyRow As Long
wsmenu.Activate
emptyRow = WorksheetFunction.CountA(Range("A:A"))
Me.Hide
wsfilms.Select
'Range("a1").End(xlDown).Offset(1, 0).Select
Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
'Add facility name
ActiveCell.Value = FacilityBox
'Add service area
ActiveCell.Offset(0, 1).Value = ServiceAreaBox
'Add date
ActiveCell.Offset(0, 2).Value = DateBox
'Add time
ActiveCell.Offset(0, 3).Value = TimeBox.Value
'Add room
ActiveCell.Offset(0, 4).Value = RoomBox.Value
'Briefing Question 1
If Yes1.Value = True Then
ActiveCell.Offset(0, 5).Value = "Yes"
Else
ActiveCell.Offset(0, 5).Value = "No"
End If
'Timeout Question 1
If Yes2.Value = True Then
ActiveCell.Offset(0, 6).Value = "Yes"
Else
ActiveCell.Offset(0, 6).Value = "No"
End If
If Yes3.Value = True Then
'Debriefing Question 1
ActiveCell.Offset(0, 7).Value = "Yes"
Else
ActiveCell.Offset(0, 7).Value = "No"
End If
'Comment 1
ActiveCell.Offset(0, 8).Value = Comment1.Value
'Briefing Question 2
If Yes4.Value = True Then
ActiveCell.Offset(0, 9).Value = "Yes"
Else
ActiveCell.Offset(0, 9).Value = "No"
End If
'Timeout Question 2
If Yes5.Value = True Then
ActiveCell.Offset(0, 10).Value = "Yes"
Else
ActiveCell.Offset(0, 10).Value = "No"
End If
'Debriefing Question 2
If Yes6.Value = True Then
ActiveCell.Offset(0, 11).Value = "Yes"
Else
ActiveCell.Offset(0, 11).Value = "No"
End If
'Comment 2
ActiveCell.Offset(0, 12).Value = Comment2.Value
'Briefing Question 3
If Yes7.Value = True Then
ActiveCell.Offset(0, 13).Value = "Yes"
Else
ActiveCell.Offset(0, 13).Value = "No"
End If
'Timeout Question 3
If Yes8.Value = True Then
ActiveCell.Offset(0, 14).Value = "Yes"
Else
ActiveCell.Offset(0, 14).Value = "No"
End If
'Debriefing Question 3
If Yes9.Value = True Then
ActiveCell.Offset(0, 15).Value = "Yes"
Else
ActiveCell.Offset(0, 15).Value = "No"
End If
'Comment 3
ActiveCell.Offset(0, 16).Value = Comment3.Value
'Briefing Question 4
If Yes10.Value = True Then
ActiveCell.Offset(0, 17).Value = "Yes"
Else
ActiveCell.Offset(0, 17).Value = "No"
End If
'Timeout Question 4
If Yes11.Value = True Then
ActiveCell.Offset(0, 18).Value = "Yes"
Else
ActiveCell.Offset(0, 18).Value = "No"
End If
'Debriefing Question 4
If Yes12.Value = True Then
ActiveCell.Offset(0, 19).Value = "Yes"
Else
ActiveCell.Offset(0, 19).Value = "No"
End If
'Comment 4
ActiveCell.Offset(0, 20).Value = Comment4.Value
'Briefing Question 5
If Yes13.Value = True Then
ActiveCell.Offset(0, 21).Value = "Yes"
Else
ActiveCell.Offset(0, 21).Value = "No"
End If
'Timeout Question 5
If Yes14.Value = True Then
ActiveCell.Offset(0, 22).Value = "Yes"
Else
ActiveCell.Offset(0, 22).Value = "No"
End If
'Debriefing Question 5
If Yes15.Value = True Then
ActiveCell.Offset(0, 23).Value = "Yes"
Else
ActiveCell.Offset(0, 23).Value = "No"
End If
'Comment 5
ActiveCell.Offset(0, 24).Value = Comment5.Value
'Briefing Question 6
If Yes16.Value = True Then
ActiveCell.Offset(0, 25).Value = "Yes"
Else
ActiveCell.Offset(0, 25).Value = "No"
End If
'Timeout Question 6
If Yes17.Value = True Then
ActiveCell.Offset(0, 26).Value = "Yes"
Else
ActiveCell.Offset(0, 26).Value = "No"
End If
'Debriefing Question 6
If Yes18.Value = True Then
ActiveCell.Offset(0, 27).Value = "Yes"
Else
ActiveCell.Offset(0, 27).Value = "No"
End If
'Comment 6
ActiveCell.Offset(0, 28).Value = Comment6.Value
'Briefing Question 7
If Yes19.Value = True Then
ActiveCell.Offset(0, 29).Value = "Yes"
Else
ActiveCell.Offset(0, 29).Value = "No"
End If
'Timeout Question 7
If Yes20.Value = True Then
ActiveCell.Offset(0, 30).Value = "Yes"
Else
ActiveCell.Offset(0, 30).Value = "No"
End If
'Debriefing Question 7
If Yes21.Value = True Then
ActiveCell.Offset(0, 31).Value = "Yes"
Else
ActiveCell.Offset(0, 31).Value = "No"
End If
'Comment 7
ActiveCell.Offset(0, 32).Value = Comment7.Value
'Additional Question 8
If Yes22.Value = True Then
ActiveCell.Offset(0, 33).Value = "Yes"
Else
ActiveCell.Offset(0, 33).Value = "No"
End If
'Comment 8
ActiveCell.Offset(0, 34).Value = comment8.Value
'Completed by
ActiveCell.Offset(0, 35).Value = comment9.Value
MsgBox " Data was successfully added to row " & ActiveCell.Row
Unload Me
End Sub
Private Sub CancelButton_Click()
Me.Hide
'Unload FilmDetails
Unload Me
End Sub
Private Sub OptionButton1_Click()
End Sub
Private Sub UserForm_Initialize()
TimeBox.Text = Format(Time, "hh:mm AM/PM")
DateBox.Text = Format(Date, "dd mmm yyyy")
With ServiceAreaBox
.AddItem "Anaesthesiology"
.AddItem "Cardiac"
.AddItem "Endoscopy"
.AddItem "General"
.AddItem "Gynaecologic"
.AddItem "Neurosurgery"
.AddItem "Obstetrics"
.AddItem "Oncology"
.AddItem "Ophthalmic"
.AddItem "Oral and Maxillofacial and Dentistry"
.AddItem "Orthopaedic"
.AddItem "Otolaryngic (ENT)"
.AddItem "Plastic and Reconstructive"
.AddItem "Thoracic"
.AddItem "Transplant"
.AddItem "Urologic"
.AddItem "Vascular"
.AddItem "All Other "
End With
End Sub
Private Sub UserForm_Terminate()
wsmenu.Select
End Sub
Private Sub Yes1_Click()
End Sub
I'm writing macro that goes through the file and marks lines that match some conditions as OK. Everything works fine when launched from the file. The problem is that when I try to launch it from another workbook I keep getting this error "Run time error 1004: Select method or Range class failed" at line
Range("C2").Select
I think that the problem lies in assigning opened file to the variable mainFile. (I can browse for the file, it opens and I can enter the year I want then it crashes)
Could you tell me what I'm doing wrong?
Sub sbVBA_To_Open_Workbook_FileDialog()
Dim strFileToOpen As Variant
Dim mainFile As Workbook
strFileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", MultiSelect:=False)
If TypeName(strFileToOpen) = "String" Then
Set mainFile = Workbooks.Open(strFileToOpen)
Else
MsgBox "No file selected."
Exit Sub
End If
'sub data works fine
Call data
With mainFile
'Everything below works fine when launched in the mainfile
Dim myYear As Date
myYear = InputBox("Choose year", "Choose year", 2018)
Range("C2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Offset(0, 2) = "M" Then
If ActiveCell.Offset(1, 2) = "C" Then
If Day(ActiveCell.Value) = 1 Then
If Year(ActiveCell.Value) = myYear Then
If Month(ActiveCell.Value) & Year(ActiveCell.Value) = Month(ActiveCell.Offset(1, 0).Value) & Year(ActiveCell.Offset(1, 0).Value) Then
'^Comparing years and months
If DateSerial(Year(ActiveCell.Offset(1, 0).Value), Month(ActiveCell.Offset(1, 0).Value + 1), 0) = ActiveCell.Offset(1, 0).Value Then
' ^End of month?
ActiveCell.Offset(0, 10).Value = "OK"
Else
ActiveCell.Offset(0, 10).Value = "NOK"
End If
Else
ActiveCell.Offset(0, 10).Value = "NOK"
End If
Else
ActiveCell.Offset(0, 10).Value = "NOK"
End If
Else
ActiveCell.Offset(0, 10).Value = "NOK"
End If
Else
ActiveCell.Offset(0, 10).Value = "NOK"
End If
Else
ActiveCell.Offset(0, 10).Value = "NOK"
End If
ActiveCell.Offset(1, 0).Select
Loop
End With
End Sub
Just because you open a workbook, it won’t automatically assume it’s the active workbook.
Please try the following code after the “With mainFile” row:
mainFile.Sheets([your desired sheet]).Activate
Then, before the range.select part, add activesheet:
ActiveSheet.Range(“C2”).Select
Please suggest a vb code, that if the text box is left blank,and during TAB/Enter, the Error message box appears for each text box.
Private Sub CommandButton1_Click()
Sheets("Attendance").Select
Range("a1").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.Value = Me.d.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.N.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.Salary.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.Remarks.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.IT.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.Outtime.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.Lunch.Value
ActiveCell.Offset(0, 3).Select
ActiveCell.Value = Me.Advance.Value
ActiveCell.Offset(0, 2).Select
ActiveCell.Value = Me.Paid.Value
End Sub
Please see below sub carefully and try to do to your user form.
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Me.TextBox1 = "" Then
MsgBox "You must enter value!"
Cancel = True
Me.TextBox1.SetFocus
End If
End Sub
The below code is automatically runs when a cell in a specified column changes and if it is not empty.
Sub mergeCells()
Dim num As Integer
Dim countmerged As Integer
If IsEmpty(ActiveCell.Value) Then
Exit Sub
Else
countmerged = -1
If ActiveCell.Offset(-1, 0).mergeCells Then
countmerged = ActiveCell.Offset(-1, 0).MergeArea.Cells.Count * -1
End If
num = ActiveCell.Offset(countmerged, -1).Value
If ActiveCell.Offset(countmerged, 0).Value = ActiveCell.Value Then
ActiveCell.ClearContents
ActiveCell.Offset(0, 1).ClearContents
ActiveCell.Offset(0, 37).ClearContents
ActiveCell.Offset(0, 36).ClearContents
ActiveCell.Offset(0, -1).ClearContents
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(2, 0).EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
Range(ActiveCell.Offset(countmerged, 37), ActiveCell.Offset(0, 37)).Merge
Range(ActiveCell.Offset(countmerged, 36), ActiveCell.Offset(0, 36)).Merge
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(countmerged, 1)).Merge
Range(ActiveCell.Offset(countmerged, -1), ActiveCell.Offset(0, -1)).Merge
Range(ActiveCell, ActiveCell.Offset(countmerged, 0)).Merge
ActiveCell.Offset(1, -1).Value = num + 1
ActiveCell.Offset(2, -1).Value = num + 2
Else
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(2, 0).EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
Selection.Offset(1, -1).Value = num + 2
Selection.Offset(2, -1).Value = num + 3
End If
End If
End Sub
if the value is the same value with the above cell, they are being merged and another row with the same formulas is inserted. This works without problem.
But if the value is not the same as the above cell, only a row must be inserted with the same formulas but it adds rows without stopping.
I don't think you are showing us the important part of the code (that sets this one off).
I would try disabling events since the macro is likely changing a cell and seeing that a cell is changed (inserted, whatever) starting your event again.
Try adding these at the beginning and ending of your macro.
Application.EnableEvents = False
Application.EnableEvents = True
I have to put jobs from one spreadsheet onto another in their priority order. If a job is listed as completed, then I do not transfer that job over. Below is my code for the top priority, "priority 1". The cell that states it's completion status sometimes has a date before or after it, which is why I put the "*" character.
Do Until IsEmpty(ActiveCell) Or count > 14
If ActiveCell.Value = "Priority I" Then
ActiveCell.Offset(0, 6).Select
If ActiveCell.value = "completed" like "*completed*" Then
ActiveCell.Offset(1, -6).Select
Else
ActiveCell.Offset(0, -1).Select
word0 = ActiveCell.Value
ActiveWindow.ActivateNext
ActiveCell = word0
ActiveWindow.ActivateNext
ActiveCell.Offset(0, -9).Select
word = Left(ActiveCell.Value, 6)
ThisWorkbook.Activate
ActiveCell.Offset(0, 1).Select
ActiveCell = word
ActiveWindow.ActivateNext
ActiveCell.Offset(0, 1).Select
word1 = ActiveCell.Value
ThisWorkbook.Activate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = word1
ActiveWindow.ActivateNext
ActiveCell.Offset(0, 1).Select
word2 = ActiveCell.Value
ThisWorkbook.Activate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = word2
ActiveWindow.ActivateNext
ActiveCell.Offset(0, 1).Select
word3 = ActiveCell.Value
ThisWorkbook.Activate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = word3
ActiveCell.Offset(1, -4).Select
ActiveWindow.ActivateNext
ActiveCell.Offset(1, 1).Select
count = count + 1
End If
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
I have confirmed that it is checking the correct column, it just doesn't catch the word completed. So the problem resides within that line, line 4.
Change
If ActiveCell.value = "completed" like "*completed*" Then
to
If Instr(1, UCase(ActiveCell.Value), "COMPLETED") > 0 Then
or
If UCase(ActiveCell.Value) like "*COMPLETED*" Then