We manage our inventories in Excel. I know its little old fashioned but we are developing business firm, and we have all our money blocked in business and no money to invest in IT.
So I wanted to know can I program in a way that excel automatically completes the product numbers?
This is example of one product category
All our design codes are of 6 digits, What I really want is that when only partial number is added and hit enter it automatically completes the remaining digits by taking the above numbers.
So for example in this case what I am expecting is, if I type 5 hit enter it automatically makes it 790705 based on above number.
Add the following VBA code to the code section of your worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oldText As String, aboveText As String, newText As String
If Target.Column = 2 And Target.Row >= 3 And Target.Text <> "" Then
oldText = Target.Text
aboveText = Target.Cells(0, 1).Text
If Len(aboveText) = 6 And Len(oldText) < 6 Then
newText = Left(aboveText, 6 - Len(oldText)) & oldText
Application.EnableEvents = False
Target.Value = newText
Application.EnableEvents = True
End If
End If
End Sub
(change the column number and minimum row number above according to the actual column/row numbers in your worksheet).
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If (Target.Column = 2 And Target.Row > 2 And Target.Value < 10) Then
Target = Target.Offset(rowOffset:=-1) + 1
End If
End Sub
As far as you enter a single digit in the new row, it transforms to the previous row + 1.
Related
For example, a speed-distance-time calculator.
Since Distance = Speed x Time,
There are 3 cells, one each for D, S, and T.
Filling any 2 of these 3 values, the other one gets calculated automatically.
Assuming you'll have your values in A1,B1 and C1
Maybe you can do a Macro that COUNT the values in the range (A1:C1), when the resulting count equals 2 (meaning at least two numbers were filled), you do a little math to calculate the remaining value. Maybe you'll need some If's to accomplish that.
You'll need to add another piece of code to trigger the macro automatically
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then 'add other cells here
Call Mymacro
End If
End Sub
First, enable the developer tab if you do not already have it.
File→Options→Customize Ribbon→check the box for Developer in the right panel
Second, go to the developer tab and click on the Visual Basic Button
Third, under the Microsoft Excel Objects folder in the left panel, double-click on Sheet1(Sheet1)
Fourth, in the box that pops up, paste the following code:
Sub Worksheet_Change(ByVal Target As Range)
Dim speed As String
Dim time As String
Dim distance As String
speed = Range("A1").Value
time = Range("B1").Value
distance = Range("C1").Value
If speed = "" And time <> "" And distance <> "" Then
Range("A1").Value = Range("C1").Value / Range("B1").Value
ElseIf speed <> "" And time = "" And distance <> "" Then
Range("B1").Value = Range("C1").Value / Range("A1").Value
ElseIf speed <> "" And time <> "" And distance = "" Then
Range("C1").Value = Range("B1").Value * Range("A1").Value
End If
End Sub
Fifth, click
File→Close and return to Microsoft Excel
Sixth, you may need to add the file location to your list of trusted locations
File→Options→Trust Center→Trust Center Settings→Trusted Locations
I'm working on a simple Excel file with some worksheets where in every one I've report hours and minutes of work. I want to show it like 313:32 that is 313 hours and 32 minutes, to do that I'm using a custom format [h]:mm
To facilitate the workers that use Excel very little, I have thought to create some vba code, so that they could insert also not only the minutes, besides the classical format [h]:mm, so they can also insert value in hours and minutes.
I report some example data that I want to have.
What I insert -> what I want that are printed inside the cell
1 -> 0:01
2 -> 0:02
3 -> 0:03
65 -> 1:05
23:33 -> 23:33
24:00 -> 24:00
24:01 -> 24:01
Then I formatted every cell that can contain a time value in [h]:mm and I wrote this code
Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo bm_Safe_Exit
With Sh
If IsNumeric(Target) = True And Target.NumberFormat = "[h]:mm" Then
If Int(Target.Value) / Target.Value = 1 Then
Debug.Print "Integer -> " & Target.Value
Application.EnableEvents = False
Target.Value = Target.Value / 1440
Application.EnableEvents = True
Exit Sub
End If
Debug.Print "Other value -> " & Target.Value
End If
End With
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
The code works well enough, but it errs when I enter 24:00 and its multiples, 48:00, 72:00 ...
This because the cell are formatted [h]:mm so 24:00 became 1 before the vba code execution!
I tried to correct the code, and the funny fact is that when I correct the 24:00, so 24:00 remain 24:00 and not 00:24, the problem switch to 1 that became 24:00 instead 00:01
My first idea was to "force" the vba code execution before the cell format, but I don't know if it is possible.
I know that seems a stupid question, but I really don't know if it is possible and how to fix it.
Any idea will be much appreciated
Requirements: Time is to be reported in Hours and Minutes, minutes is the lowest measure ( i.e.: whatever the amount of time is to be reported in hours and the partial hours in minutes, i.e. 13 days, 1 hour and 32 minutes or 13.0638888888888889 shall be shown as 313:32 )
Users should be allowed to enter time in two different manners:
To enter only minutes: The value entered shall be a whole number (no decimals).
To enter hours and minutes: The value entered shall be composed by two whole numbers representing the hours and the minutes separated a colon :.
Excel Processing Values Entered:
Excel intuitively process the Data type and Number.Format of the values entered in cells.
When the Cell NumberFormat is General, Excel converts the values entered to the data type in relation with the data entered (String, Double, Currency, Date, etc. ), it also changes the NumberFormat as per the “format” entered with the value (see table below).
When the Cell NumberFormat is other than General, Excel converts the values entered to the data type corresponding to the format of the cell, with no changes to the NumberFormat (see table below).
Therefore, it's not possible to know the format of the values as entered by the user, unless the values entered can be can intercepted before Excel applies its processing methods.
Although the values entered cannot be intercepted before Excel process them, we can set a validation criteria for the values entered by the users using the Range.Validation property.
Solution: This proposed solution uses:
Workbook.Styles property (Excel): To identify and format the Input cells.
Range.Validation property (Excel): To communicate the users the format required for the values entered, enforcing them to enter the data as text.
Workbook_SheetChange workbook event: To validate and process the values entered.
It's suggested to use a customized style to identify and format the input cells, actually OP is using the NumberFormat to identify the input cells, however it seems that there could also be cells with formulas, or objects (i.e. Summary Tables, PivotTables, etc.) that require the same NumberFormat. By using the customized style only for the input cells, the non-input cells can be easily excluded from the process.
The Style object (Excel) allows to set the NumberFormat, Font, Alignment, Borders, Interior and Protection at once for a single or multiple cells. The procedure below adds a customized Style named TimeInput. The name of the Style is defined as a public constant because it will be used across the workbook.
Add this into an standard module
Public Const pk_StyTmInp As String = "TimeInput"
Private Sub Wbk_Styles_Add_TimeInput()
With ActiveWorkbook.Styles.Add(pk_StyTmInp)
.IncludeNumber = True
.IncludeFont = True
.IncludeAlignment = True
.IncludeBorder = True
.IncludePatterns = True
.IncludeProtection = True
.NumberFormat = "[h]:mm"
.Font.Color = XlRgbColor.rgbBlue
.HorizontalAlignment = xlGeneral
.Borders.LineStyle = xlNone
.Interior.Color = XlRgbColor.rgbPowderBlue
.Locked = False
.FormulaHidden = False
End With
End Sub
The new Style will show in the Home tab, just select the input range and apply the Style.
We’ll use the Validation object (Excel) to tell users the criteria for the time values and to force them to enter the values as Text.
The following procedure sets the style of the Input range and adds a validation to each cell:
Private Sub InputRange_Set_Properties(Rng As Range)
Const kFml As String = "=ISTEXT(#CLL)"
Const kTtl As String = "Time as ['M] or ['H:M]"
Const kMsg As String = "Enter time preceded by a apostrophe [']" & vbLf & _
"enter M minutes as 'M" & vbLf & _
"or H hours and M minutes as 'H:M" 'Change as required
Dim sFml As String
Application.EnableEvents = False
With Rng
.Style = pk_StyTmInp
sFml = Replace(kFml, "#CLL", .Cells(1).Address(0, 0))
With .Validation
.Delete
.Add Type:=xlValidateCustom, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=sFml
.IgnoreBlank = True
.InCellDropdown = False
.InputTitle = kTtl
.InputMessage = kMsg
.ShowInput = True
.ErrorTitle = kTtl
.ErrorMessage = kMsg
.ShowError = True
End With: End With
Application.EnableEvents = True
End Sub
The procedure can be called like this
Private Sub InputRange_Set_Properties_TEST()
Dim Rng As Range
Set Rng = ThisWorkbook.Sheets("TEST").Range("D3:D31")
Call InputRange_Set_Properties(Rng)
End Sub
Now that we have set the input range with the appropriated style and validation, let’s write the Workbook Event that will process the Time inputs:
Copy these procedures in ThisWorkbook module:
Workbook_SheetChange - Workbook event
InputTime_ƒAsDate - Support function
InputTime_ƒAsMinutes - Support function
…
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const kMsg As String = "[ #INP ] is not a valid entry."
Dim blValid As Boolean
Dim vInput As Variant, dOutput As Date
Dim iTime As Integer
Application.EnableEvents = False
With Target
Rem Validate Input Cell
If .Cells.Count > 1 Then GoTo EXIT_Pcdr 'Target has multiple cells
If .Style <> pk_StyTmInp Then GoTo EXIT_Pcdr 'Target Style is not TimeInput
If .Value = vbNullString Then GoTo EXIT_Pcdr 'Target is empty
Rem Validate & Process Input Value
vInput = .Value 'Set Input Value
Select Case True
Case Application.IsNumber(vInput): GoTo EXIT_Pcdr 'NO ACTION NEEDED - Cell value is not a text thus is not an user input
Case InStr(vInput, ":") > 0: blValid = InputTime_ƒAsDate(dOutput, vInput) 'Validate & Format as Date
Case Else: blValid = InputTime_ƒAsMinutes(dOutput, vInput) 'Validate & Format as Minutes
End Select
Rem Enter Output
If blValid Then
Rem Validation was OK
.Value = dOutput
Else
Rem Validation failed
MsgBox Replace(kMsg, "#INP", vInput), vbInformation, "Input Time"
.Value = vbNullString
GoTo EXIT_Pcdr
End If
End With
EXIT_Pcdr:
Application.EnableEvents = True
End Sub
…
Private Function InputTime_ƒAsDate(dOutput As Date, vInput As Variant) As Boolean
Dim vTime As Variant, dTime As Date
Rem Output Initialize
dOutput = 0
Rem Validate & Process Input Value as Date
vTime = Split(vInput, ":")
Select Case UBound(vTime)
Case 1
On Error Resume Next
dTime = TimeSerial(CInt(vTime(0)), CInt(vTime(1)), 0) 'Convert Input to Date
On Error GoTo 0
If dTime = 0 Then Exit Function 'Input is Invalid
dOutput = dTime 'Input is Ok
Case Else: Exit Function 'Input is Invalid
End Select
InputTime_ƒAsDate = True
End Function
…
Private Function InputTime_ƒAsMinutes(dOutput As Date, vInput As Variant) As Boolean
Dim iTime As Integer, dTime As Date
Rem Output Initialize
dOutput = 0
Rem Validate & Process Input Value as Integer
On Error Resume Next
iTime = vInput
On Error GoTo 0
Select Case iTime = vInput
Case True
On Error Resume Next
dTime = TimeSerial(0, vInput, 0) 'Convert Input to Date
On Error GoTo 0
If dTime = 0 Then Exit Function 'Input is Invalid
dOutput = dTime 'Input is Ok
Case Else: Exit Function 'Input is Invalid
End Select
InputTime_ƒAsMinutes = True
End Function
The table below shows the output for various types of values entered.
The simplest way appears to be to use the cell text (i.e. how the cell is displayed) in preference to the actual cell value. If it looks like a time (e.g. "[h]:mm", "hh:mm", "hh:mm:ss") then use that to add the value of each time part accordingly (to avoid the 24:00 issue). Otherwise, if it's a number, assume that to be minutes.
The below method also works for formats like General, Text and Time (unless the time begins with a days part, but it could be further developed to deal with that too where necessary).
Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo bm_Safe_Exit
Dim part As String, parts() As String, total As Single
Application.EnableEvents = False
If Not IsEmpty(Target) And Target.NumberFormat = "[h]:mm" Then
'prefer how the Target looks over its underlying value
If InStr(Target.Text, ":") Then
'split by ":" then add the parts to give the decimal value
parts = Split(Target.Text, ":")
total = 0
'hours
If IsNumeric(parts(0)) Then
total = CInt(parts(0)) / 24
End If
'minutes
If 0 < UBound(parts) Then
If IsNumeric(parts(1)) Then
total = total + CInt(parts(1)) / 1440
End If
End If
ElseIf IsNumeric(Target.Value) Then
'if it doesn't look like a time format but is numeric, count as minutes
total = Target.Value / 1440
End If
Target.Value = total
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
I already have a barcode scanner VBA function, that recognizes the barcode number, but the problem I have is that I have to click enter every time, is there any way to do it automatically and store the count in a certain column? Currently it works if I enter the same value stored in column B, it will count the records in column C, but I want to avoid hitting enter every time
This is what I got so far
Private Sub btnAdd_Click()
Dim TargetCell As Range
If WorksheetFunction.CountIf(Sheets("Sheet1").Columns(2), TextBox1.Value) = 1 Then
Set TargetCell = Sheets("Sheet1").Columns(2).Find(TextBox1.Value, , xlValues, xlWhole).Offset(0, 1)
TargetCell.Value = TargetCell.Value + 1
Else
MsgBox "Code not found"
End If
Me.Hide
End Sub
It's hard to say what you have. For example, who presses the button? Or, does your scanner enter a return. I think the code below should work under any circumstances. Please try it.
Private Sub TextBox1_Change()
Dim TargetCell As Range
Dim Qty As Long
With TextBox1
If Len(.Value) = 3 Then
Set TargetCell = Worksheets("Sheet1").Columns(2) _
.Find(.Value, , xlValues, xlWhole)
If TargetCell Is Nothing Then
MsgBox """" & .Value & """ Code not found"
Else
With TargetCell.Offset(0, 1)
Qty = .Value + 1
.Value = Qty
End With
Application.EnableEvents = False
TextBox1.Value = "Count = " & Qty
Application.EnableEvents = True
End If
.SelStart = 0
.SelLength = Len(.Value)
End If
End With
End Sub
I think you have a user form and in this form you have a text box called TextBox1. If so, the code should be in the user form's code module. If you have a text box in your worksheet paste the code to the code module of the sheet on which the text box resides.
Now, you need to adjust this line of code If Len(.Value) = 3 Then to determine when to process the data. This is because the Change event will occur whenever even a single character is entered. I tested with 3 characters. Change the number to a value equal to the length of the numbers you scan in. In theory that still leaves the CR hanging which your scanner might also send. If that causes a problem experiment with >= in place of the = in my code.
The code will add the scan to the existing quantity, just as you had it, and indicate the new total in the text box, in case you are interested. You might replace this with "OK". The code will select the text it enters. Therefore when you enter something else, such as a new scan, it will be over-written without extra clicks being required.
I am trying to force a specific range of cells in Excel to auto capitalize a specific phrase.
For example: We commonly enter type of aircraft such as Saab, Citation, etc. I have a VB script to force Proper Case but there are other times that we abbreviate such as DA20, CJ3, etc.
What I would like (if this is even possible) is for the long names (if used) to remain Proper Case however if they type specific phrases, I would like it to ignore the script and allow it as entered OR auto capital the first two characters.
Diamond or DA20 would be acceptable
Citation or CJ3 would be acceptable
What I don't want is someone that is lazy to type
citation or cj3
diamond or da20
Is this possible? I would be willing to create a whitelist of sorts of all the abbreviations if necessary that would be allowed.
I was hoping some sort "IF" statement may work on the VBA script but I am unsure how to write this.
You can trigger auto-updating of certain ranges using the Worksheet Change event. This requires the user to partially enter the desired input (they need to exit the cell for it to trigger) and will auto-fill the remainder. For instance:
Public boolChanging As Boolean
Private Sub Worksheet_Change(ByVal rng As Range)
Dim strAutoFinish As String, iStartPos As Integer
'Exit unless updates occur when and where you want
If boolChanging Or rng.Row < 1 Or rng.Column <> 1 Or rng.Columns.Count > 1 Or rng.Rows.Count > 1 Then Exit Sub
If rng = "" Then Exit Sub 'This needs to be here in case multiple cells are editted
boolChanging = True
strAutoFinish = ";DA20;Diamond;CJ3;Citation;..."
iStartPos = InStr(UCase(strAutoFinish), ";" & UCase(rng))
If iStartPos > 0 Then
rng = Mid(strAutoFinish, iStartPos + 1, InStr(iStartPos + 1, strAutoFinish, ";") - iStartPos - 1)
Else 'Leave this part if you want it to delete invalid entries
rng = ""
End If
boolChanging = False
End Sub
I have a template that records hours worked by employees. Column 5 shows their contracted hours for the week and Column 14 shows additional hours they work. Part time staff (less than 37.5 hrs p/week) who work additional hours are paid a standard rate. However once they exceed 37.50 hours for the week they are paid at time and a half (this is recorded in a seperate column).
The code below picks up the total number of hours for the week (column 18) and if it exceeds 37.5 it will prompt the user to record some of the hours at time and a half. It's a failsafe way of ensuring people are paid correctly.
The code below works almost perfectly however if the contracted hours are less than 10, the message box pops up regardless. I think it is because I have a String data type for the hours in the code is as a String but I can't seem to get it to work with other data types. Any assistance would be much appreciated.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 14 Then
Dim I As Integer, CheckHours As Boolean
Dim MonthX As Worksheet
I = 6
CheckHours = False
Set MonthX = ThisWorkbook.ActiveSheet
Dim FT As String
FT = 37.5
Application.ScreenUpdating = False
'Use the Employee Number column to perform the check
Do While MonthX.Cells(I, 3) <> ""
'Declare variables
Dim ContractHours As String
Dim HoursPaid As String
Dim TotalHours As String
ContractHours = MonthX.Cells(I, 5)
HoursPaid = MonthX.Cells(I, 14)
TotalHours= MonthX.Cells(I, 18)
'If the contract hours plus the additional hours are greater than 37.50 then display warning
If TotalHours > FT Then
MsgBox "WARNING: Check the additional hours entered for " & _
MonthX.Cells(I, 2).Value & " " & MonthX.Cells(I, 1).Value & _
" as they will need to be split between Additional Basic and Overtime." & _
vbNewLine & vbNewLine & _
"Please refer to the Additional Hours Guidelines tab for more information.", vbOKOnly, "Please Check"
CheckHours = True
End If
I = I + 1
Loop
'Cancel boolean
If CheckHours = True Then
Cancel = True
End If
Application.ScreenUpdating = True
End If
End Sub
I don't know if your logic is right, but here's a rewrite that does the same thing as your code. There's a lot of extra stuff in your code that doesn't seem to have a purpose, so I removed it.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim dTotalHours As Double
Dim aMsg(1 To 5) As String
Const dFULLTIME As Double = 37.5
i = 6
If Target.Column = 14 Then
Do While Len(Me.Cells(i, 3).Value) > 0
dTotalHours = Me.Cells(i, 18).Value
If dTotalHours > dFULLTIME Then
aMsg(1) = "WARNING: Check the additional hours entered for"
aMsg(2) = Me.Cells(i, 2).Value
aMsg(3) = Me.Cells(i, 3).Value
aMsg(4) = "as they will need to be split between Additional Basic and Overtime." & vbNewLine & vbNewLine
aMsg(5) = "Please refer to the Additional Hours Guidelines tab for more information."
MsgBox Join(aMsg, Space(1)), vbOKOnly, "Please Check"
End If
i = i + 1
Loop
End If
End Sub
Some notes
Excel stores numeric cell values as Doubles. If you're reading a number from a cell, there's really no reason to use anything but a Double.
When you're in the sheet's class module (where the events are), you can use the Me keyword to refer to the sheet. You refer to Activesheet, but what you really want is the sheet where the selection change occurred. They happen to be the same in this case, but for other events they may not be.
It's faster to check the length of a string rather than to check if <>"".
Your FT variable never changes making it not variable at all. A constant may be a better choice.
I use an array to store all the elements of a long message, then use Join to make the final string. Easier to read and maintain.
I'm a keyboard guy, so this hits closer to home for me that most, but a message box every time the selection changes? That means that if I attempt to use the arrow keys to get to the cell where I will fix the error, I will get constant message boxes. Brutal. Maybe the _Change event or _BeforeSave event are worth consideration.
Try declaring as a 'single' instead of a 'String'
We were told to declare decimal numbers as singles when at uni. It may solve your issue.
Or another thing I have notice but don't know if it will affect it, you don't have an ELSE with your IF statement
The following code may need a bit of tweaking, but it should come close to what you need. It implements several of the suggestions in the comments to your question. The source of your difficulty was the use of string variables to deal with numeric values.
I've declared FT, ContractHours, HoursPaid, and SumHours as Single variables, and Cancel as a Boolean (although you don't use it in the subroutine).
You can set "Option Explicit" - which requires that variables be declared - as the default for your code by choosing Tools/Options from the menu bar of the VBA editor and then check-marking the "Require Variable Declaration" option on the Editor tab.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer, CheckHours As Boolean, Cancel As Boolean
Dim MonthX As Worksheet
Dim FT As Single
Dim ContractHours As Single
Dim HoursPaid As Single
Dim SumHours As Single
Set MonthX = ThisWorkbook.ActiveSheet
i = 6
FT = 37.5
If Target.Column = 14 Then
Application.ScreenUpdating = False
'Use the Employee Number column to perform the check
Do While MonthX.Cells(i, 3).Value <> ""
'Assign variables
ContractHours = MonthX.Cells(i, 5).Value
HoursPaid = MonthX.Cells(i, 14).Value
SumHours = MonthX.Cells(i, 18).Value
'When the contract hours plus the additional hours are greater than 37.50
' display warning
If SumHours > FT Then
MsgBox "WARNING: Check the additional hours entered for " & _
MonthX.Cells(i, 2).Value & " " & MonthX.Cells(i, 1).Value & _
" as they will need to be split between Additional Basic and Overtime." & _
vbNewLine & vbNewLine & _
"Please refer to the Additional Hours Guidelines tab for more information.", vbOKOnly, "Please Check"
CheckHours = True
End If
i = i + 1
Loop
'Cancel boolean
If CheckHours = True Then
Cancel = True
End If
Application.ScreenUpdating = True
End If
End Sub