Delete Square in VBA - excel

I have encountered this problem. The first row is highlighters. How can I solve it.
Here is the code :
Sub DeleteSquare()
If (Selection.Name <> "Square") Then
MsgBox ("Not a Square!")
Exit Sub
End If
If (MsgBox("Are you sure?", vbYesNo, "Confirmation") = vbYes) Then
Selection.DeletenumSquares = numSquares - 1
Range("NoOfSquares").Value = numSquares
End If
End Sub

Related

How to edit data from a form in a sheet to another form with the Data using VBA?

ive been learning VBA and Excel in the past 2 weeks by my own during my free time, but sometimes we need some help, and currently ive no one to help besides the internet. So ive developed a Form(Sheet1) in a sheet using shapes and excel cells so the user could perform operations like insert,update, new register to the other sheet(Data) which is my Data Sheet or DataTable more specifically. But im struggling to get the update button to work. i could definitely use some help.
Heres my code:
Public Upda As String
Sub Search()
'
' Search Macro
'
Dim Sheet As String, ans
On Error GoTo Erro:
Data.Activate
Sheet = Data.Name
ans = InputBox("Write down the ID", "Search")
If ans = "" Then
Sheet1.Activate
Exit Sub
End If
Dim C
With Worksheets(Data).Range("A:A")
Set C = .Find(ans, LookIn:=xlValues, lookat:=xlWhole)
If Not C Is Nothing Then
C.Activate
Sheet1.Cells(17, 9).Value = C.Value ' Id
Sheet1.Cells(9, 4).Value = C.Offset(0, 1).Value ' Name
' here goes the other fields to be inserted
Sheet1.Activate
Upda = Sheet1.Cells(17, 9).Text
Else
Sheet1.Activate
MsgBox "Insert a valid ID", vbCritical, "Search"
End If
End With
Exit Sub
Erro:
MsgBox "Something went wrong, contact the Adm!", vbCritical, "Erro"
End Sub
'Update macro need to get a fix
Sub Update()
'update macro
Dim Sheet As String
On Error GoTo Erro
If IsEmpty(Range("I17")) Or IsEmpty(Range("D9")) Then ' there are more fields to validate
MsgBox "All the fields must have a value", vbExclamation, "Upda"
If Upda = "" Then
MsgBox "Please retry the search", vbExclamation, "Update"
Exit Sub
End If
Dim C
'
Data.Activate
Sheet = Data.Name
With Worksheets(Sheet).Range("A:A")
Set C = .Find(Upda, LookIn:=xlValues, lookat:=xlWhole)
If Not C Is Nothing Then
C.Activate
ActiveCell.Value = Sheet1.Cells(17, 9).Text ' ID
ActiveCell.Offset(0, 1).Value = Sheet1.Cells(9, 4).Text ' Name
'Update the table with the contents of the form1
Sheet1.Activate
Range("I6:J6").ClearContents
' remaining code to clear the contents of the form sheet1
Upda = ""
'Call clear
Else
MsgBox "ID number not found", vcCritical, "Update"
End If
End With
Exit Sub
Erro:
MsgBox "Something went wrong, contact the Adm!", vbCritical, "ERRO"
End Sub
Sub clear()
'
' clear Macro
'
Range("I17").ClearContents
' remaining code to cleear the contents of the form sheet1
Upda = ""
End Sub
Each one of those macros are associated with a Button(Shape), evrything is working besides the Update one.
Im getting the follow error which makes no sense to me
PS:if u need more information please let me know
You are missing the End if statement for the first If in the below block of code:
If IsEmpty(Range("I17")) Or IsEmpty(Range("D9")) Then ' there are more fields to validate
MsgBox "All the fields must have a value", vbExclamation, "Upda"
End if 'Missing If in the original code
If Upda = "" Then
MsgBox "Please retry the search", vbExclamation, "Update"
Exit Sub
End If

Excel Userform to update existing Data

I would like to overwrite data using a Userform, I can call the data to the form based on a Combobox (unique reference from column A in my data sheet). I am failing to send updated data back, and am stuck on a Run-time error '13.
I have looked at a number of posts but cannot pick out a thread to success! Any help appreciated. I have left the code simple, to update the 4 column of that row. Ultimately I will expand from the 2nd column onwards.
Private Sub cmbtrade_Change() - this part works as expected
Dim trade_name As String
If Me.cmbtrade.Value = "" Then
MsgBox "Trade Can Not be Blank!!!", vbExclamation, "Trade"
Exit Sub
End If
trade_name = cmbtrade.Value
On Error Resume Next
Dim trade As Double
trade_name = cmbtrade.Value
TextBox16.Text = Application.WorksheetFunction.VLookup(trade_name,
Sheets("Sheet2").Range("A2:D43"), 4, False)
End Sub
The problem part....
Private Sub cmdupdate_Click()
If Me.cmbtrade.Value = "" Then
MsgBox "Trade Name Can Not be Blank", vbExclamation, "Trade"
Exit Sub
End If
trade_name = cmbtrade.Value
Sheets("sheet2").Select
Dim rowselect As Double
rowselect = Me.cmbtrade.Value (this is where my mismatch error occurs)
rowselect = rowselect + 1
Rows(rowselect).Select
Cells(rowselect, 4) = Me.TextBox16.Value
End Sub
enter image description here
Try this. You don't actually need to convert the combobox to a Long, but it's good practice I think.
Private Sub cmdupdate_Click()
If Me.cmbtrade.Value = "" Then
MsgBox "Trade Name Can Not be Blank", vbExclamation, "Trade"
Exit Sub
End If
Dim rowselect As Long
rowselect = CLng(Me.cmbtrade.Value) + 1
Sheets("sheet2").Cells(rowselect, 4) = Me.TextBox16.Value
End Sub

.range(ContRow&":"&ContRow).entirerow.Delete

This is the line I'm having trouble with:
.range(ContRow&":"&ContRow).entirerow.Delete
This is the macro:
Sub Cont_Delete()
With Sheet1
If MsgBox("Are you sure you want to delete this record?", vbYesNo, "Delete
Record") = vbNo Then Exit Sub
If .Range("B3").Value = Empty Then Exit Sub
ContRow = .Range("B3").Value.Range(ContRow&":"&ContRow).EntireRow.Delete.Range("D18").Select
End With
End Sub
Error message:
Syntax error and compile error expected: list separator or )
you are concatenating code lines
you most probably need this:
Sub Cont_Delete()
With Sheet1
If IsEmpty(.Range("B3")) Then Exit Sub
If MsgBox("Are you sure you want to delete this record?", vbYesNo, "Delete Record ") = vbNo Then Exit Sub
.Rows(.Range("B3").Value).EntireRow.Delete
.Range("D18").Select
End With
End Sub

checkbox macro to restrict editing

The code below is meant to allow only the authoriser (network name "JSMITH") to tick my checkbox so that she confirms she's happy with the report to be sent out (multiple report users but only one authoriser). But I keep getting an error "Object required". What am I doing wrong in the code below? thanks
Private Sub CheckBox1_Click()
If Environ("username") <> "JSMITH" Then
CheckBox1.Value = False
End If
End Sub
I think what you are after is the following code:
Sub CheckBox1_Click()
If ActiveSheet.Shapes("Check Box 1").ControlFormat.Value = 1 Then
If Environ("username") = "JSMITH" or Environ("username") = "DTailor" Then
'Do nothing
Else
'Uncheck because user not matching
ActiveSheet.Shapes("Check Box 1").ControlFormat.Value = 0
MsgBox ("You are not authorized to tick this box.")
End If
End If
End Sub
For an ActiveX checkbox I would use the following code:
Sub CheckBox1_Click()
If ActiveSheet.OLEObjects("CheckBox1").Object.Enabled = True Then
If Environ("username") = "JSMITH" or Environ("username") = "DTailor" Then
'Do nothing
Else
'Uncheck because user not matching
ActiveSheet.OLEObjects("CheckBox1").Object.Enabled = False
MsgBox ("You are not authorized to tick this box.")
End If
End If
End Sub

Userform VLOOKUP not working

I’m trying to extract the employee name based on the employee id with a VLOOKUP formula in a User Form.
The code below inst working.
Private Sub CommandButton2_Click()
Label4.Caption = Sheet1.Application.WorksheetFunction.VLookup(TextBox1.Text, Range("A:B"), 2, False)
End Sub
The provlem here is when there is no match found. That's the cause of the error message. Here is the
the VBA code you should use:
Private Sub CommandButton2_Click()
On Error Resume Next
Label1.Caption = Sheet1.Application.WorksheetFunction.VLookup(TextBox1.Text, Range("A:B"), 2, False)
If Err.Number <> 0 Then
Err.Clear
Label1.Caption = "not found"
End If
End Sub

Resources