I have an ActiveX TextBox named txtNewPeymankar and a command button named cmdAdd. I want when user type a string in txtNewPeymankar in my form and click Add button, that value compare with column one of Table1 (Table1[column1]) in DATA sheet and if match with any of cells, show error massage "duplicated value!. please try again." and if not match, save it in the end of column1.
I write this code but not work.
Private Sub cmdAdd_Click()
Dim iRow1 As Long
iRow1 = Sheets("DATA").Range("A1048576").End(xlUp).Row + 1
If Application.Match(txtNewPeymankar.Text, Range(Table1[column1]), 0) Then
MsgBox "duplicated value!. please try again.", vbOKOnly + vbInformation
Else
With ThisWorkbook.Sheets("DATA")
.Range("A" & iRow1).Value = txtNewPeymankar.Value
End With
End If
End Sub
Related
I am trying to make a row in my Excel table mandatory before users close the document, then display a pop-up message stating "cells require input".
I am running into an issue where users are still getting the pop-up message even if they have filled out all the mandatory cells.
This is a screenshot of what all I typed out. I have this in the workbook area
I am typing what's in the screenshot, in the workbook area, and have it to run beforeclose.
This is the what I used below. My required fields is the row A3-O3
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15).Value = "" Then
MsgBox "Cell(s) require input", vbInformation, "Kutools for Excel"
Cancel = True
End If
End Sub
view of my spreadsheet
A plus would be a pop-up message letting the user know which cells are empty & for it to highlight the cells that are empty also
Use WorksheetFunction.CountBlank:
If Worksheetfunction.CountBlank(ActiveSheet.Range("A3:O3")) > 0 Then
MsgBox "Cell(s) require input", vbInformation
End If
Or SpecialCells(xlCellTypeBlanks):
On Error Resume Next
Dim rng As Range
Set rng = ActiveSheet.Range("A3:O3").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then
MsgBox "Cell(s) " & rng.Address(False, False) & " require input", vbInformation
End If
Note that Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15) does not refer to A3:O3.
In the Immediate Window, put:
? Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15).Address
The result is
$DB$31
When deleting a product from the "Prod_List"(sheet2) I need to copy the row and paste it into a "DeletedList"(sheet3).
This sub "Delete_product" should, from the display on the "Summary"(sheet1) ask the user to confirm the action, then copy the row from the "Prod_List"(sheet2), pasting it into the "DeletedList"(sheet3) and clean the view from the display on the "Summary"(sheet1)
'Delete Product
Option Explicit
Dim PRodRow As Long, ProdCol As Long
Sub Delete_Product()
With Summary
If .Range("B8").Value = Empty Then
MsgBox "Please Select a correct product to delete"
Exit Sub
End If
If MsgBox("Are you sure you want to delete this Product?", vbYesNo, "Delete Product") = vbNo Then Exit Sub
PRodRow = DeletedList.Range("A999999").End(xlUp).Row + 1
For ProdCol = 1 To 22
'DeletedList.Cells(PRodRow, ProdCol).Value = .Range(DeletedList.Cells(1, ProdCol).Value).Value 'add data to product to deleted tab
Next
With Prod_List
PRodRow = Summary.Range("B8").Value 'product row
Prod_List.Range(PRodRow & ":" & PRodRow).EntireRow.Delete
With Summary
.Range("J4,J5,J6,J7,J9,J10,n5,J11,N7,N8,N9,N12,N13,N14,J13,J14,J15").ClearContents
End With
End With
End With
End Sub
When I run it, it deletes the row correctly, however, it doesn't copy the row into the "DeletedList"(sheet3), however, when the line below is not as an observation the data is pasted on the "DeletedList"(sheet3), but it doesn't delete it from the "ProductList"(sheet2)
'DeletedList.Cells(PRodRow, ProdCol).Value =
.Range(DeletedList.Cells(1, ProdCol).Value).Value 'add data to
product to deleted tab "
Any ideas or suggestions on how to fix it?
Thank you!
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
I have the following in my userform:
CheckBox11 CheckBox12 CheckBox13 CheckBox14 CheckBox15
CheckBox21 CheckBox22 CheckBox23 CheckBox24 CheckBox25
Also, in my excel I have following named ranges:
range11 range12 range13 range14 range15
range21 range22 range23 range24 range25
I want to loop through each of the checkboxes, and in case of True, do something with the range, Say copy-paste the corresponding ranges to another location.
I have a nested For loop, i = 1 to 2
and j = 1 to 5
and then inside another long variable nm = i*10+j
now I want to refer to the CheckBox and Range with nm.
Any other alternative is also welcome.
Thanks in Advance.
Maybe something like this ?
Sub Test()
For Each objControl In ActiveSheet.OLEObjects
If TypeName(objControl.Object) = "CheckBox" And objControl.Object = True Then
rngName = Replace(objControl.Name, "CheckBox", "range")
Range(rngName).Select
MsgBox rngName & " selected"
End If
Next
End Sub
The sub will select the named range at each selected CheckBox (True value).
But that's if the checkbox is an ActiveX and the named range is within the same sheet where the checkboxes are.
Anyway, you can just change the Range(rngName).Select .... MsgBox rngName & " selected" line to whatever process you want to do with the corresponding named range.
Below if the checkbox is in a Userform:
Private Sub CommandButton1_Click()
For Each ctrl In Me.Controls
If TypeName(ctrl) = "CheckBox" And ctrl = True Then
rngName = Replace(ctrl.Name, "CheckBox", "range")
Range(rngName).Select
MsgBox rngName & " selected"
End If
Next
End Sub
see codes below.
I have the 'beforesave' code in the Workbook module and it works fine when I'm in the active sheet. However from the table I use on sheet 2 I also have a pivot table on sheet 1. To refresh my pivot I use an inserted button with an attached macro (this is in the module section)
Sub Refresh_Pivot()
'
' Refresh_Pivot Macro
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveWorkbook.Save
End Sub
On Activate.Workbook.Save its starts to act on my other code (which is in the workbook module), I want this to happen as a pivot table with missing data is not a good tool. However on using this it defaults with an error and highlights the cell.Offset(0, 1).Select - How can I prevent this?
Ideally I want the user to select OK on the msgbox and then the screen page changes to Sheet 2 and highlights the offending cell.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim esave As Range
Dim psave As Range
Dim jsave As Range
Dim RAll As Range
Dim cell As Range
Set esave = Sheet2.Range("Table1[Estimated Claim (USD)]")
Set psave = Sheet2.Range("Table1[Provisional Claim (USD)]")
Set jsave = Sheet2.Range("Table1[Agreed Claim (USD)]")
Set RAll = Union(esave, psave, jsave)
For Each cell In RAll
If cell.Value <> "" And cell.Offset(0, 1).Value = "" Then
Dim missdata
missdata = MsgBox("Missing Data - Enter the Date for WorkBook to Save", vbOKOnly, "Missing Data")
Cancel = True
cell.Offset(0, 1).Select
Exit For
End If
Next cell
End Sub
.Select should be avoided.
INTERESTING READ
I also want to know why are you trying to select that cell? What is the purpose. If you want to interact with it, then you can do that without selecting it. For example
If cell.Value <> "" And cell.Offset(0, 1).Value = "" Then
Dim missdata
missdata = MsgBox("Missing Data - Enter the Date for WorkBook to Save", vbOKOnly, "Missing Data")
Cancel = True
With cell.Offset(0, 1)
'
''~~> Do something
'
End With
Exit For
End If
Having said that if you still want to select that cell then you need to be on that sheet. There are two ways now. One is like I mentioned in the comment above.
Add Sheet2.Activate just before For Each cell In RAll in the Workbook_BeforeSave event or do that in the button's click event.
Sub Refresh_Pivot()
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Sheet2.Activate
ActiveWorkbook.Save
End Sub
Another point. You might want to pass Cancel = True before the Exit For to disable the save?