I have a excel file and there are 20 sheets
I need to search and find several sheet on my excel that want and add email to M1 Cell
Could you please help me.
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
döngü:
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "ABC" Then
Sheets("ABC").Select
Range("M1").Select
ActiveCell.FormulaR1C1 = "abc#hotmail.com"
If Worksheets(i).Name = "ABC2" Then
Sheets("ABC2").Select
Range("M1").Select
ActiveCell.FormulaR1C1 = "abc2#hotmail.com"
GoTo döngü:
pass:
Next i
Application.ScreenUpdating = True
MsgBox "mail assign done"
End Sub
You can simply use below sub.
Sub WriteEmail()
On Error GoTo HarunErrHandler
Sheets("ABC").Range("M1") = "abc#hotmail.com"
Sheets("ABC2").Range("M1") = "abc2#hotmail.com"
Exit Sub
HarunErrHandler:
MsgBox "No such sheet found.", vbInformation, "Info"
'MsgBox("Error Number: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Error")
End Sub
Many thanks Harun i made a little change with your comments.
Following code worked well.
Thank you so much
Sub WriteEmail()
Sheets("ABC").Range("M1") = "abc#hotmail.com"
On Error Resume Next
Sheets("ABC2").Range("M1") = "abc2#hotmail.com"
On Error Resume Next
Sheets("ABC3").Range("M1") = "abc3#hotmail.com"
On Error Resume Next
MsgBox ("process done")
End Sub
Related
I need some help. I am new to Excel VBA. I am trying to create a userform for stock inventory records and I been geting the automation error -2147467259. My problem is that the code works but after a few mouse clicks (10 or more) or after long usage, I keep getting this error. My code:
Private Sub cbPickID_Change()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim tbl_issuance As ListObject
Set tbl_issuance = shIssuance.ListObjects("tblIssuance")
If Not tbl_issuance.DataBodyRange Is Nothing Then
tbl_issuance.DataBodyRange.Delete
End If
Dim tbl_pick As ListObject
Set tbl_pick = shPickList.ListObjects("tblPickList")
On Error GoTo ErrDetect
With tbl_pick.DataBodyRange
.AutoFilter field:=1, Criteria1:=Me.cbPickID.Value
End With
Dim pick_row As Long
pick_row = shPickList.Range("A" & Application.Rows.Count).End(xlUp).Row
shPickList.Range("A3:L" & pick_row).SpecialCells(xlCellTypeVisible).Copy
shIssuance.Range("A3").PasteSpecial (xlPasteValuesAndNumberFormats)
tbl_pick.AutoFilter.ShowAllData
Application.CutCopyMode = False
Dim issued_row As Long
issued_row = shIssuance.Range("A" & Application.Rows.Count).End(xlUp).Row
With Me.lbPickList
.ColumnHeads = True
.ColumnCount = 12
.ColumnWidths = ("40,40,40,110,0,45,40,60,90,0,0,0")
.RowSource = shIssuance.Range("A3:L" & issued_row).Address
End With
ErrDetect:
If Err.Number = 1004 Then
MsgBox "No records found!"
Exit Sub
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
When I click debug, the error point at this
tbl_issuance.DataBodyRange.Delete
all my reference are in the same file. if I want to use the Excel VBA again, I need to close all Excel file and re-open them again.
any advice is highly appreciated.
I am currently running a VBA script in excel to allow for specific username and password access to specific sheets. I was following this tutorial on youtube and everything seemed to be going well until I began encountering errors.
I am getting a Type mismatch error in my code, which is below. There are two lines that are giving me errors, they are commented, any help would be greatly appreciated!
Option Explicit
Sub CheckUser()
Dim UserRow, SheetCol As Long
Dim SheetNm As String
With Sheet34
.Calculate
If .Range("B6").Value = Empty Then 'Incorrect Username
MsgBox "Please enter a correct username"
Exit Sub
End If
If .Range("B5").Value <> True Then 'Incorrect Password
MsgBox "Please enter a correct password"
Exit Sub
End If
UserForm1.Hide
UserRow = .Range("b6").Value 'userrow
.Range("B3").Value = ""
.Range("b4").Value = ""
For SheetCol = 6 To 26
SheetNm = .Cells(2, SheetCol).Value 'SheetName
If .Cells(UserRow, SheetCol).Value = "Ð" Then ' line where error occurs
Sheets(SheetNm).Protect "TEP2003"
Sheets(SheetNm).Visible = xlSheetVisible
End If
If .Cells(UserRow, SheetCol).Value = "Ï" Then ' line where error occurs
Sheets(SheetNm).Visible = xlVeryHidden
End If
Next SheetCol
End With
End Sub
Sub closeworkbook()
Sheet1.Activate
Dim WkSht As Worksheet
For Each WkSht In ThisWorkbook.Worksheets
If WkSht.Name <> "Main" Then WkSht.Visible = xlSheetVeryHidden
Next WkSht
ThisWorkbook.Save
End Sub
Use the Range.Text property. Range.Text will not fix a worksheet error code but it will evaluate one as text where Range.Value will fail. Combine the two with an ElseIf; there is no point in evaluating the second if the first passes.
...
If .Cells(UserRow, SheetCol).Text = "Ð" Then
...
ElseIf .Cells(UserRow, SheetCol).Text = "I" Then
...
End If
I was trying to understand how to skip the 1st row (A) of my sheet when i use below code which check whether any value available on my excel sheet.
Sub IsActiveSheetEmpty()
If WorksheetFunction.CountA(Cells) = 0 Then
MsgBox ActiveSheet.Name & " is empty"
Else
MsgBox ActiveSheet.Name & " is not empty"
End If
End Sub
Thanks in Advance
Try the following (does implicitly reference active sheet so you may want to explicitly state the worksheet name.) It will use the last row and column for which ever version of Excel you are using:
Sub IsActiveSheetEmpty()
If WorksheetFunction.CountA(Range(Cells(2, "A"), Cells(Cells.Rows.Count, Cells.Columns.Count))) = 0 Then
MsgBox ActiveSheet.Name & " is empty"
Else
MsgBox ActiveSheet.Name & " is not empty"
End If
End Sub
Option Explicit
Sub IsActiveSheetEmpty()
Dim myRange As Range
Set myRange = Range("A2",Cells(2,1).SpecialCells(XlCellType.xlCellTypeLastCell))
If WorksheetFunction.CountA(myRange) = 0 Then
MsgBox ActiveSheet.Name & " is empty"
Else
MsgBox ActiveSheet.Name & " is not empty"
End If
End Sub
Seems like it should be a boolean-returning function rather than sub, but:
Option explicit
Sub IsActiveSheetEmpty()
Dim ws as worksheet
Set ws = Activesheet
With ws
If application.CountA(.range(.range("B1"),.cells(.rows.count,.columns.count))) = 0 Then
MsgBox .Name & " is empty"
Else
MsgBox .Name & " is not empty"
End If
End with
End Sub
Untested, written on mobile. Does it do what you want?
Edit: Think you mean column A?
Sub IsActiveSheetEmpty()
If WorksheetFunction.CountA("A2:A5") = 0 Then 'skips A1
MsgBox ActiveSheet.Name & " is empty"
Else
MsgBox ActiveSheet.Name & " is not empty"
End If
End Sub
i currently have a problem with a simple login form in excel (VBA), when having an error, continuing and having another error it still gives me two more MsgBoxes with errors but with the "Unload Me" and "Goto Ende" it should close itself completely.
Any guesses why this isn't working? I know this is very basic and probably very redundant, but it should still work.
Public Name As Variant
Public Password As Variant
Private Sub Btn_Register_Cancel_Click()
Unload Me
End Sub
Private Sub Btn_Register_Register_Click()
Start:
Dim Error As Integer
Error = 0
Name = Tbx_Register_Name.Value
Password = Tbx_Register_Password.Value
'Check for Name, Password, Password2 if empty
If Tbx_Register_Name.Value = "" Then
Error = MsgBox("Please enter a username.", _
vbRetryCancel, "Error")
If Error = 2 Then
Unload Me
GoTo Ende
Else
Application.ScreenUpdating = False
Register.Hide
Register.Show
Application.ScreenUpdating = True
GoTo Start
End If
ElseIf Tbx_Register_Password.Value = "" Then
Error = MsgBox("Please enter a password.", _
vbRetryCancel, "Error")
If Error = 2 Then
Unload Me
GoTo Ende
Else
Application.ScreenUpdating = False
Register.Hide
Register.Show
Application.ScreenUpdating = True
GoTo Start
End If
ElseIf Tbx_Register_Password2.Value = "" Then
Error = MsgBox("This field cannot be empty.", _
vbRetryCancel, "Error")
If Error = 2 Then
Unload Me
GoTo Ende
Else
Application.ScreenUpdating = False
Register.Hide
Register.Show
Application.ScreenUpdating = True
GoTo Start
End If
End If
With Workbooks("General Makro.xlsx").Worksheets("User")
'Check for Username match in registration list
For i = 1 To 100
If .Cells(i, 1).Value = Name Then
Error = MsgBox("This username is already taken.", _
vbRetryCancel, "Error")
If Error = 2 Then
Unload Me
i = 100
GoTo Ende
Else
Application.ScreenUpdating = False
Register.Hide
Register.Show
Application.ScreenUpdating = True
GoTo Start
End If
End If
Next i
End With
'Check for the passwords to match
If Tbx_Register_Password.Value = Tbx_Register_Password2.Value Then
With Workbooks("General Makro.xlsx").Worksheets("User")
For i = 1 To 100
If .Cells(i, 1) = "" Then
.Cells(i, 1).Value = Name
.Cells(i, 2).Value = Password
Tbx_Register_Password.Value = ""
Tbx_Register_Password2.Value = ""
Application.ScreenUpdating = False
Register.Hide
Login.Show
Tbx_Login_Name.Value = .Cells(i, 1).Value
Tbx_Login_Password.Value = .Cells(i, 2).Value
Application.ScreenUpdating = True
i = 100
GoTo Ende
End If
Next i
End With
Else
Error = MsgBox("The passwords have to match!", vbRetryCancel, "Error")
If Error = 2 Then
Unload Me
GoTo Ende
Else
Application.ScreenUpdating = False
Register.Hide
Register.Show
Application.ScreenUpdating = True
GoTo Start
End If
End If
Ende:
End Sub
Edit: I Actually Tried to do the 2nd UserForm for the login, and i happen to get the same problem there. Everything works just fine, until i close the whole program, then the error-message appears again. Am i unloading the userform incorrect? Maby the login userform says open and continues when everything is getting closed.
Edit 2: I could just turn off alerts but that would be an ugly solution and definitely nothing i want to implement on every close button in the program.
You can verify blank values in textboxes with this:
If TextBox.Text = "" Then
MsgBox "Is blank!"
Unload Me
GoTo Ende
End If
'Your code
Ende: Exit Sub
To verify the username and password in a database, you can do this:
Dim sh As Worksheet
Dim LastRow As Long
Dim UserRange As Range
Dim UserMatch As Range
Set sh = ThisWorkbook.Sheets("database")
LastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
Set UserRange = sh.Range("A1:A" & LastRow)
Set UserMatch = UserRange.Find(What:=UserTextBox.Text, LookIn:=xlValues)
If Not UserMatch Is Nothing Then
MsgBox "User exists!"
If PwdTextBox.Text = UserMatch.Offset(0, 1) Then
MsgBox "Pwd matched!"
'do something
Else
MsgBox "Wrong password!"
'do something
End If
Else
MsgBox "User dont exists!"
'do something
End If
This will work if in the database the usernames are in column A and the passwords in column B.
i am farly new to VBa and am trying to learn by building or replicating existing vba sheets.
In this one, i am getting an error in the following code:
Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
Dim cPayroll As String
Dim I As Integer
Dim findvalue
'error block
On Error GoTo errHandler:
'get the select value from the listbox
For I = 0 To lstLookup.ListCount - 1
If lstLookup.Selected(I) = True Then
cPayroll = lstLookup.List(I, 1)
End If
Next I
'find the payroll number
Set findvalue = Sheet2.Range("F:F").Find(What:=cPayroll, LookIn:=xlValues).Offset(0, -3)
'add the database values to the userform
cNum = 21
For X = 1 To cNum
Me.Controls("Reg" & X).Value = findvalue
Set findvalue = findvalue.Offset(0, 1)
Next
'disable adding
Me.cmdAdd.Enabled = False
Me.cmdEdit.Enabled = True
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
It is giving me the error :" 424 Object required"
i cant seem to find the error
Can someone help me?
Thanks in advance.
Change
Me.cmdAdd.Enabled = False
Me.cmdEdit.Enabled = True
to
Me.Controls("cmdAdd").Enabled = False
Me.Controls("cmdEdit").Enabled = True