I have an excel sheet which contains two columns ( the column A contains Names and the column B contains Number Phones ).
I have created a comboBox with the list of names and I want to select a name from this comboBox and then update its corresponding phone number. I tried this code but it does not work.
Sub UpdateNumber()
Dim Ans As String, Index As Integer
Ans = InputBox("What is " & NameForm.ComboBox1.Value & " 's new phone number?")
If Ans <> "" Then
Index = NameForm.ComboBox1.ListIndex
Sheets("Names").Range("A" & Index).Offset(0, 1).Value = Ans
End If
End Sub
Could someone help me, please ?
try below code
Sub UpdateNumber(Optional boxShow As Boolean = True)
Dim Ans As String, Index As Integer
If boxShow = false Then exit sub
Ans = InputBox("What is " & NameForm.ComboBox1.Value & " 's new phone number?")
If Ans <> "" Then
Index = NameForm.ComboBox1.ListIndex
Sheets("Names").Range("A" & Index).Offset(0, 1).Value = Ans
End If
End Sub
sub btn_onclick()
boxShow True 'no msgbox
boxShow False 'with msgbox
boxShow 'no msgbx
end sub
found there
Related
I have 2 sheets on excel , first one with some rows and columns , an ActiveX control Button and checkbox , when i click on this button i execute this code :
Private Sub CommandButton1_Click()
If CheckBox1.Value = True Then Call do_OM
End Sub
Private Sub do_OM()
Dim Name_sheet As String
Dim row_se As Long
Dim Vl_1 As String
row_se = CheckBox1.TopLeftCell.Row
Vl_1 = Range("D" & row_se)
Name_sheet = ActiveSheet.Name
Sheets("Or_Mission").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "OM" & & Name_sheet
Range("C11") = Vl_1
MsgBox Range("C11") & Vl_1
ActiveWorkbook.Save
End Sub
What i want is to copy the value of ( Vl_1 = Range("D" & row_se) ) that exists in first sheet TO the second sheet using Range("C11") = Vl_1
The problem is The msgBox shows exactly the wanted result , But in the second sheet Range("C11") is empty !! i don't know what's happening , if any one can help
How can msgBox of Range("C11") that's in sheet 2 shows the value while in excel The cell is always empty ??
At the same time im using MsgBox becaus Debug.Print doesn't print anything ?? don't know why
Thank you :) .
Excel VB newbie. I know I must be missing something very simple. How do I get before_save event to work with more than one worksheet? Only one needs code. I have it in ThisWorkbook. It works if I only have one sheet in my workbook.
After seeing the comment that it doesn't matter if there's more than one worksheet I looked again at my code. I fixed the code and now the BeforeSave event will trigger and not save until all conditions are met like it's supposed to.
The BeforeSave event triggers if I put it in ThisWorkbook. But if I put it in Sheet1 and call the sub in ThisWorkbook, it still runs the sub like it's supposed to but doesn't prevent it from saving. Hoping this makes sense. I know the code is messy so please bear with me.
Sheet1:
Sub checkSheet1()
Dim cellCount As Variant, findEmpty As String, Counter%
allYellowCellsArray = Array(Range("C6"), Range("C7"), Range("C8"), Range("C9"), Range("C18"), Range("C19"), Range("C20"), Range("C21"), Range("C22"), Range("C29"), Range("C30"), Range("C31"), Range("C32"), Range("C33"), Range("C42"), Range("C62"))
noDateYellowCellsArray = Array(Range("C6"), Range("C7"), Range("C8"), Range("C9"), Range("C18"), Range("C19"), Range("C20"), Range("C21"), Range("C22"), Range("C29"), Range("C30"), Range("C31"), Range("C32"), Range("C33"), Range("C42"))
emptyCell = ""
Counter = 0
Debug.Print vbNewLine & "List the values of each cell in the array:"
'count number of yellow/empty cells
For Each cellCount In allYellowCellsArray
Debug.Print cellCount.Address() & " value is " & cellCount & " and color is " & cellCount.DisplayFormat.Interior.Color
If cellCount = emptyCell Then
Counter = Counter + 1
End If
Next
'If-Then statements to alert how many yellow cells are still empty.
If Counter >= 1 Then
MsgBox "(" & Counter & ") Mandatory Cells Have Not Been Completed", vbExclamation, "Missing Information"
'cellCount = "Enter Missing Information"
End If
For Each cellCount In noDateYellowCellsArray
If cellCount.Value = "" Then
cellCount.Value = "Enter Missing Information"
End If
Next
'Evaluate all yellow cells to prevent empty cells and make sure the set values have been changed ----
Dim cellValue As Variant
Dim fieldsAreYellow As Boolean
fieldsAreYellow = True
Dim redCellColor As Boolean
redCellColor = True
Dim cellCellColor As Variant
Debug.Print vbNewLine & "List cells that are red:"
For Each cellCellColor In allYellowCellsArray 'check for red cells
If cellCellColor.DisplayFormat.Interior.Color = 255 Then 'if cell background color is red
redCellColor = True
Debug.Print cellCellColor.Address() & " is " & cellCellColor.DisplayFormat.Interior.Color
Cancel = True
End If
If redCellColor = False Then
MsgBox "There are no more red cells."
Cancel = True
End If
Next cellCellColor
Dim cellCountRedCells As Variant, redCellCounter%
redCellCounter = 0
For Each cellCountRedCells In allYellowCellsArray
If cellCountRedCells.DisplayFormat.Interior.Color = 255 Then 'red
redCellCounter = redCellCounter + 1
Debug.Print "redCellCounter is " & redCellCounter
'MsgBox "redCellCounter is " & redCellCounter
End If
Next
Debug.Print "redCellCounter is " & redCellCounter
'Check to see if cells in array have been changed
Debug.Print vbNewLine & "List the current background color of the first non-numeric cell that stopped the loop:"
For Each cellValue In allYellowCellsArray
If cellValue = "Enter Missing Information" Then
Debug.Print vbNewLine & cellValue
fieldsAreYellow = False
Debug.Print cellValue.Address() & " color is " & cellValue.DisplayFormat.Interior.Color
MsgBox "Check all of your cells for correct information." & vbNewLine & "There are still (" & redCellCounter & ") red cells.", vbCritical, "SAVE CANCELLED"
Cancel = True ' ** prevent the file from being saved **
Exit For
End If
Next cellValue
'Final check
If (fieldsAreYellow = True) And (redCellCounter = 0) Then
MsgBox "The document will be saved." & vbNewLine & "Remember the naming convention." & vbNewLine & "Customer_PIP Seal Calculator_Part Number rev#_Part Name_DDMMYY", vbInformation, "Good to Go!"
Cancel = False 'allow save
Else:
MsgBox "This file will not save until all of the cells have correct information.", vbCritical, "SAVE CANCELLED"
Cancel = True 'cancel save
End If
End Sub
ThisWorkbook:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call Sheet1.checkSheet1
End Sub
I created a new excel file and tested this event. It works perfectly on both sheets.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
MsgBox "OK"
End Sub
I suggest to try this on a new file and then copy your code to the new file.
In order to make the event was as you need, the called Sub must be transformed in a Function returning Boolean.
The event code should look like this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = Sheet1.checkSheet1
End Sub
And the called function, like this:
Public Function checkSheet1() As Boolean
If 1 = 1 Then
MsgBox "The saving cannot take place..."
checkSheet1 = True 'instead of Cancel = True in the Sub
Else
checkSheet1 = False
End If
End Function
You must adapt your code to finally return something like checkSheet1 = Cancel. But take care to properly declare Dim Cancel as Boolean...
If something unclear, please, do not hesitate to ask for clarifications. If you need me to transform your existing Sub, I can do it, but I think it is better for you do do that, in order to understand the meaning and learn...
Loop Through Worksheets In BeforeSave
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Create a list of worksheet names.
Const wsList As String = "Sheet1,Sheet2,Sheet3"
Dim nms() As String ' Declare an array of type 'String'.
nms = Split(wsList, ",") ' Write the list to the array.
Dim ws As Worksheet ' Declare a worksheet variable.
Dim n As Long ' Declare a 'counter' variable of type 'Long'.
' Loop through the elements (names) in the array.
For n = 0 To UBound(nms)
' Define current worksheet.
Set ws = ThisWorkbook.Worksheets(nms(n))
' Do something, e.g. write some text to cell 'A1' and autofit column 'A'.
ws.Range("A1").Value = "Testing worksheet '" & ws.Name & "'."
ws.Columns("A").AutoFit
Next n
End Sub
I am working on an Excel Userform to generate a report for a lot entered on a given day.
The report is stored in a Word document which contains the results of between 1 and 8 quality samples (number of samples varies by lot).
The Userform is meant to load in Excel, receive a lot number and date from the user, retrieve samples from that day and lot from a different sheet in the Excel workbook and then copy the data into a new Word doc based on a custom template.
The input part of the Userform and the Word template are both set up. I hit a snag on the event handling procedure for the "OK" button.
The form's OK button event handler gives
compile error
on
Sub makeReport(lNum As Integer, pDay As Date)
The editor isn't indicating an issue in my makeReport method; the call to makeReport in the event handler is highlighted red.
I am using the Excel 2013 VBA editor, and neither the built-in debugging tools in Excel, the Microsoft online VBA docs nor various forum posts found via Google can give me a complete answer to what is wrong and how to fix it.
OK Button event handler
Private Sub OKButton_Click() 'OK button
'Declare variables
Dim lNum As Integer
Dim pDay As Date
Dim name As String
Dim nStr As String
Dim dStr As String
'Error handler for incorrect input of lot number or pack date
On Error GoTo ErrorHandler
'Convert input values to correct types
nStr = TextBox1.Value
dStr = TextBox2.Value
'Set variable values
lNum = CInt(nStr)
MsgBox ("Step 1 Done" + vbCrLf + "Lot Number: " + nStr)
pDay = Format(dStr, "mm/dd/yyyy")
MsgBox ("Step 2 Done" + vbCrLf + "Pack Date: " + dStr)
name = nameDoc(pDay, lNum)
MsgBox ("Step 3 Done" + vbCrLf + "Report Name: " + name)
'Check for existing report
If Dir("\\CORE\Miscellaneous\Quality\Sample Reports\" + name) Then
MsgBox ("The file " + name + "already exists. Check \\CORE\Miscellaneous\Quality\Sample Reports for the report.")
Unload UserForm1
Exit Sub
Else
makeReport(lNum, pDay)
End If
'Unload User Form and clean up
Unload UserForm1
Exit Sub
ErrorHandler:
MsgBox ("Error. Please Try Again.")
'Unload UserForm1
End Sub
makeReport sub
Sub makeReport(lNum As Integer, pDay As Date)
'Template Path: \\CORE\Miscellaneous\Quality\Sample Reports\Template\Defect Report.dotm
'Save path for finished report: \\CORE\Miscellaneous\Quality\Sample Reports
'Generate doc name
Dim name As String
name = nameDoc(pDay, lNum)
'Initialize word objects and open word
Dim wApp As Word.Application
Dim wDoc As Word.Document
Set wApp = CreateObject("Word.Application")
wApp.Visible = True
Set wDoc = wApp.Documents.Add(Template:=("\\CORE\Miscellaneous\Quality\Sample Reports\Template\Defect Report.dotm"), NewTemplate:=False, DocumentType:=0)
'Initialize excel objects
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Defect Table")
'Fill in lot number and date at top of report
With wDoc
.Application.Selection.Find.Text = "<<date>>"
.Application.Selection.Find.Execute
.Application.Selection = pDay
.Application.Selection.EndOf
.Application.Selection.Find.Text = "<<lot>>"
.Application.Selection.Find.Execute
.Application.Selection = lNum
End With
'Initialize loop variables
Dim row1 As Integer
Dim row2 As Integer
Dim diff As Integer
Dim more As Boolean
Dim num As Integer, num1 As Integer, col As Integer
Dim count As Integer
count = 0
diff = 0
more = False
'Do while loop allows variable number of samples per day
Do While count < 8
'Checks for correct starting row of day
row1 = WorksheetFunction.Match(lNum, wsSheet.Range(), 0)
row2 = WorksheetFunction.Match(pDay, wsSheet.Range(), 0)
If IsError(row1) Or IsError(row2) Then
'Breaks for loop once all samples have been copied over
Exit Do
ElseIf row1 = row2 Then
num = 4
num1 = num
Do While num < 31
'Column variable
col = count + 1
'Copies data to word doc, accounting for blank rows in the word table
Select Case num
Case 6, 10, 16, 22, 30
num1 = num1 + 1
Case Else
num1 = num1
End Select
ActiveDocument.Tables(1).Cell(num1, col) = ActiveSheet.Range().Cells(row1, num)
num = num + 1
Next
Else
'Deiterates count to adjust for differences between row1 and row2
count = count - 1
End If
'Moves the collision to below row1 to allow MATCH to find next viable result
diff = row1 + 1
wsSheet = wsSheet.Range().Offset(diff, 0)
'Iterates count
count = count + 1
Loop
'Zeroes out word objects
Set wdDoc = Nothing
Set wdApp = Nothing
'Saves Document using regular name format for ease of access
wDoc.SaveAs2 Filename:="\\CORE\Miscellaneous\Quality\Sample Reports\" + name, FileFormat:=wdFormatDocumentDefault, AddtoRecentFiles:=False
End Sub
makeReport(lNum, pDay)
The brackets here imply that you are expecting something to be returned which can't happen as makeReport is a Sub not a Function. This is causing the compile error. To correct just remove the brackets.
You also have an additional problem as there is a mismatch with pDay. When you format a date you convert it from a Date, which is just a numeric value, into a String.
In OKButton_Click() try changing:
pDay = Format(dStr, "mm/dd/yyyy")
to:
pDay = CDate(dStr)
so that it matches the data type expected by makeReport. You can then apply the required formatting in makeReport by changing
.Application.Selection = pDay
to
.Application.Selection = Format(pDay, "mm/dd/yyyy")
I have a Userform with several textboxes and a command button. When the information is entered and submitted the information is transfered to the first empty row.
I need a code that would counta() text within 4 columns within that row. So translate =IF(IsBlank($A2),"",COUNTA(E2:H2) to VBA code to calculate after the user submitted the information.
Option Explicit
Sub test()
Debug.Print "Var 1 : "; CountRangeIf("not(A3="""")", Range("E3:H3"))
Dim testCriteria As Boolean
testCriteria = Not (Range("A3").Value = "")
Debug.Print "Var 2 : "; CountRangeIf_Var2(testCriteria, Range("E3:H3"))
End Sub
Public Function CountRangeIf(IfCriteriaString As String, CountRange As Range) As Variant
Dim resultCriteria As Boolean
CountRangeIf = "" ' Result = "" if Criteria is false
resultCriteria = Evaluate(IfCriteriaString)
With Application.WorksheetFunction
If resultCriteria Then
CountRangeIf = .CountA(CountRange)
End If
End With
End Function
Public Function CountRangeIf_Var2(IfCriteria As Boolean, CountRange As Range) As Variant
CountRangeIf_Var2 = "" ' Result = "" if Criteria is false
With Application.WorksheetFunction
If IfCriteria Then
CountRangeIf_Var2 = .CountA(CountRange)
End If
End With
End Function
Presuming we're using Sheet1
and presuming your Row # is already stored in
ThisRowNum variable
Following should be close to what you asked for
If Trim(CStr(Sheets("Sheet1").Range("A" & ThisRowNum).Value)) = "" then
xCtr = 0 ' Your formula used a null string - you can fix this
else
xCtr = WorksheetFunction.CountA(Sheets("Sheet1").Range("E" & ThisRowNum &":H" & ThisRowNum))
endif
The xCtr variable is the result
I am trying to fix a simple loop so that the message box won't go away until the user enters an integer.
Here is my code:
Sub PlateMicro()
strName = InputBox(Prompt:="Enter number of wells in plate. The default is 96 (8X12).", _
Title:="PLATE SETUP", Default:="96")
Dim wellCount As Object
Dim numericCheck As Boolean
numericCheck = IsNumeric(wellCount)
If IsNumeric(wellCount) Then
Range("A1").Value = wellCount 'Enter the number of plate wells selected into template.
Else: strName = InputBox(Prompt:="You must enter an integer. Enter number of wells in plate. The default is 96 (8X12)." _
, Title:="PLATE SETUP", Default:=userDefaultChoice)
End If
End Sub
Consider:
Sub intCHECK()
Dim var As Variant
var = "whatever"
While Not IsNumeric(var)
var = Application.InputBox(Prompt:="Enter integer", Type:=2)
Wend
MsgBox "Thanks!"
End Sub
This will allow you to Exit if you touch Cancel