I am trying to implement a functionality that obliged the user filling in column B a value from a dropdown list to also fill right after another cell column I from same row and sheet. With possibility to cancel the action, removing then his choice at column B. I am thinking to do that thanks to a message box to fill, clicking ok would then fill the cell at column I.
I found nothing about this kind of function on the internet. Could you help me finding a simple code?
Thank you
I did this that answers perfectly my need, for information
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 2 Then
ThisRow = Target.Row
If Target.Value = "Sourcing" Then
inputdate = InputBox("Please enter Sourcing end date target dd/mm/yyyy", "Enter Sourcing end date", Format(inputdate, "mm/dd/yyyy"))
If inputdate = "" Or inputdate = vbNullString Then
Range("I" & ThisRow).Value = ""
Range("B" & ThisRow).Value = ""
Else
If IsDate(inputdate) Then
inputdate = Format(CDate(inputdate), "mm/dd/yyyy")
Range("I" & ThisRow).Value = inputdate
Else
MsgBox "Wrong date format"
Range("I" & ThisRow).Value = ""
Range("B" & ThisRow).Value = ""
End If
End If
ElseIf Target.Value = "Phasing out" Then
inputdate = InputBox("Please enter History target date dd/mm/yyyy", "Enter History date", Format(inputdate, "mm/dd/yyyy"))
If inputdate = "" Or inputdate = vbNullString Then
Range("I" & ThisRow).Value = ""
Range("B" & ThisRow).Value = ""
Else
If IsDate(inputdate) Then
inputdate = Format(CDate(inputdate), "mm/dd/yyyy")
Range("I" & ThisRow).Value = inputdate
Else
MsgBox "Wrong date format"
Range("I" & ThisRow).Value = ""
Range("B" & ThisRow).Value = ""
End If
End If
ElseIf Target.Value = "History" Then
Range("I" & ThisRow).Value = Date
ElseIf Target.Value = "" Then
Range("I" & ThisRow).Value = ""
End If
End If
End Sub
Had to find a trick about date format that was changing from dd/mm to mm/dd, add some condition if window is cancelled or date empty and this works fine
Related
Hoping I can get help here, I am currently using the Dim Long in my VBA code but since I am referring to multiple columns the code became quite long. Now, I wanted to try named range reference instead but i cannot make it work.
This is my current code:
Dim i As Long
For i = 8 To 500
'if details is incomplete
If Range("AA" & i).Value > 0 Then
If Range("AB" & i).Value = "Error" Or Range("AC" & i).Value = "Error" Or Range("AD" & i).Value = "Error" _
Or Range("AE" & i).Value = "Error" Or Range("AF" & i).Value = "Error" Or Range("AG" & i).Value = "Error" _
Or Range("AH" & i).Value = "Error" Or Range("AI" & i).Value = "Error" Or Range("AJ" & i).Value = "Error" _
Or Range("AK" & i).Value = "Error" Or Range("AL" & i).Value = "Error" Or Range("AM" & i).Value = "Error" _
Or Range("AN" & i).Value = "Error" Or Range("AO" & i).Value = "Error" Or Range("AP" & i).Value = "Error" _
Or Range("AQ" & i).Value = "Error" Or Range("AR" & i).Value = "Error" Or Range("AS" & i).Value = "Error" _
Or Range("AT" & i).Value = "Error" Or Range("AU" & i).Value = "Error" Or Range("AV" & i).Value = "Error" _
Or Range("AW" & i).Value = "Error" Or Range("AX" & i).Value = "Error" Or Range("AY" & i).Value = "Error" Then
MsgBox "One of the mandatory field is not provided, please check all cells highlighted in yellow & make sure details is provided."
End If
Endif
I named range AA = "Validation" & range AB:AY = "Details" how can i declare it and use named range instead of writing each columns one by one?
As #Ike suggests - use the COUNTIF formula. Can be used on the worksheet or within VBA. If you want to return the addresses of each error then Find might be a better route.
Sub Test()
Dim Result As Long
Result = Errors(Sheet1.Range("AB8:AY500"))
If Result > 0 Then
MsgBox "There are " & Result & " errors in the range."
End If
End Sub
Public Function Errors(Target As Range) As Long
Errors = WorksheetFunction.CountIf(Target, "Error")
End Function
Conditional formatting can handle this. I have demonstrated for a smaller range. Feel free to apply it for your required range.
NON VBA
Formula used: =AND($AA8>0,AB8="Error")
VBA
You can use conditonal formatting in VBA as well.
I have commented the code.
Option Explicit
Sub Sample()
Dim i As Long
Dim ws As Worksheet
Dim CondTrue As Boolean
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Check if there is even one cell which satisfies our condition
For i = 8 To 500
If .Evaluate("=AND(AA" & i & ">0,COUNTIF(AB" & i & ":AY" & i & ",""Error"")>0)") = True Then
CondTrue = True
Exit For
End If
Next i
'~~> If found then apply conditional formatting
If CondTrue Then
With .Range("AB8:AY500")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=AND($AA8>0,AB8=""Error"")"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
'~~> Show message box
MsgBox "One of the mandatory field is not provided, please check all cells highlighted in yellow & make sure details is provided."
Else
MsgBox "All Good!"
End If
End With
End Sub
IN ACTION (VBA)
In my script After a Validation Item is Selected the code then selects the next cell and opens the validation list, what I am trying to accomplish is after that selection to then select the cell in the next column and then open that validation list to make a selection. I cannot seem to allow the one script to run after the other. The top snippet is where I am trying to implement the second If Not to run after the first If Not. The bottom snippet is the entire script.
If TheSize = "" Then
MsgBox "Now pick the size for your " & vbNewLine & TheItem, , "Apparel Selection" & " (Item# " & TheId & ")"
Target.Offset(, 2).Select
Target.Offset(, 2).Application.SendKeys "%{UP}"
End If
If TheColor = "" Then
MsgBox "Now pick the Color for your " & vbNewLine & TheItem, , "Apparel Selection" & " (Item# " & TheId & ")"
Target.Offset(, 3).Select
Target.Offset(, 3).Application.SendKeys "%{UP}"
End If
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A3")) Is Nothing Then
Range("B3:B3").ClearContents
Range("C3:C6").ClearContents
Range("D3:D6").ClearContents
Range("E3:E6").ClearContents
Range("F3:F6").ClearContents
End If
If Target.Count = 1 Then
If Cells(Target.Row, Target.Column + 1).Value = "" Then
TheItem = Target.Value
TheSize = Target.Offset(, 2).Value
TheColor = Target.Offset(, 3).Value
TheId = Target.Offset(, 4).Value
If Not Intersect(Target, Range("C3:C6")) Is Nothing Then
ItemVal = InputBox("How many of the " & (TheItem) & "'s Do you want?", "Apparel Selection" & " (Item# " & TheId & ")")
Cells(Target.Row, Target.Column + 1).Value = ItemVal
If TheSize = "" Then
MsgBox "Now pick the size for your " & vbNewLine & TheItem, , "Apparel Selection" & " (Item# " & TheId & ")"
Target.Offset(, 2).Select
Target.Offset(, 2).Application.SendKeys "%{UP}"
End If
If TheColor = "" Then
MsgBox "Now pick the Color for your " & vbNewLine & TheItem, , "Apparel Selection" & " (Item# " & TheId & ")"
Target.Offset(, 3).Select
Target.Offset(, 3).Application.SendKeys "%{UP}"
End If
If ItemVal = "" Then
MsgBox "Pick The Item You Really Really Want", , "Canceled!"
Application.EnableEvents = False
Target.ClearContents
End If
End If
End If
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C3:C6" & Cells(Rows.Count, "D").End(xlUp).Row)) Is Nothing Then
If Target.Value = vbNullString Then
Range("D" & Target.Row) = vbNullString
Range("E" & Target.Row) = vbNullString
Range("F" & Target.Row) = vbNullString
End If
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
End Sub
In one sheet i have this data
A APPLE
B BANANA
C CROW
D DEER
E EGG
F FISH
G GOAT
H HUT
In another sheet whenever i write A in a column, apple should be written in the next column.
A (i write A) then Apple should be written in the column next to it.
You'd have to use VBA Script in Excel. Starting with an example in Worksheet.Change Event (Excel), you could use the following code to achieve your goal.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
ThisRow = Target.Row
If Target.Value = "" Then
Range("B" & ThisRow).Value = ""
Range("B" & ThisRow).Show
End If
If Target.Value = "A" Then
Range("B" & ThisRow).Value = "Apple"
Range("B" & ThisRow).Show
End If
If Target.Value = "B" Then
Range("B" & ThisRow).Value = "Banana"
Range("B" & ThisRow).Show
End If
If Target.Value = "C" Then
Range("B" & ThisRow).Value = "Crow"
Range("B" & ThisRow).Show
End If
If Target.Value = "D" Then
Range("B" & ThisRow).Value = "Deer"
Range("B" & ThisRow).Show
End If
If Target.Value = "E" Then
Range("B" & ThisRow).Value = "Egg"
Range("B" & ThisRow).Show
End If
If Target.Value = "F" Then
Range("B" & ThisRow).Value = "Fish"
Range("B" & ThisRow).Show
End If
If Target.Value = "G" Then
Range("B" & ThisRow).Value = "Goat"
Range("B" & ThisRow).Show
End If
End If
End Sub
Writing 'A' in column A and row 1, you need to move off that cell to trigger the Worksheet_Change event and you should see Apple appear in column B on the same row.
I am working on a VBA application, where when I select an option from a drop down list (created using data validation) a few columns should populate automatically. It is working fine if I select an option from the drop down list for each cell individually. However if I drag down an option over a few rows, only the data for the top row gets populated whereas that for the remaining rows do not. How do I tackle this? This is my code under Worksheet_Change function
Private Sub Worksheet_Change(ByVal Target As range)
If Target.Column = 22 Then
ThisRow = Target.Row
On Error GoTo ExitSub
If Target.Value = "E" Then
range("W" & ThisRow).Value = range("R" & ThisRow).Value
range("X" & ThisRow).Value = ""
On Error GoTo 0
ElseIf Target.Value = "T" Then
range("W" & ThisRow).Value = ""
range("X" & ThisRow).Value = range("S" & ThisRow).Value
ElseIf Target.Value = "M" Then
range("W" & ThisRow).Value = ""
range("X" & ThisRow).Value = ""
ElseIf Target.Value = "N" Then
range("W" & ThisRow).Value = 0
range("X" & ThisRow).Value = 0
ElseIf Target.Value = "R" Then
range("W" & ThisRow).Value = range("T" & ThisRow).Value
range("X" & ThisRow).Value = range("U" & ThisRow).Value
End If
End If
Exit Sub
ExitSub:
Exit Sub
End Sub
If you're selecting multiple cells, then you have more than one row and/or column in your Target range, so statements referencing .Column and .Row are going to be ambiguous.
If you wrap this code in a loop that steps through each cell within the range, it should update the whole range, not just the first cell.
I am creating a macro enable spreadsheet to help me keep track of support tickets that I am currently working on in my engineering position.
I have 16 columns that provide information about each support ticket, such as Date, Serial Number of the device, Device location and so forth. A new row is a new support ticket.
Let's say we are working with row 50.
Column E represents the status of the device for which the ticket has been opened. Such as Deployed, Configure, and Floor Install.
Column F represents the device type such as Exalogic, and Exadata
Column K represents whether or not I need to create a special ticket depending on the value of E "OR" the value of F. Column K's values can be either yes or no.
This is what I have thus far and it does work with the column E range.
Dim rng As Range
Dim cellE
Dim cellF
If Not Intersect(Range("E12:E100"), Target) Is Nothing Then
Application.EnableEvents = False
For Each rng In Intersect(Range("E12:E100"), Target)
Set cellE = Range("E" & rng.Row)
Set cellK = Range("K" & rng.Row)
If Range("E" & rng.Row) = "Configure" Then
Range("K" & rng.Row) = "No"
ElseIf Range("E" & rng.Row).Value Like "*Floor*" Then
Range("K" & rng.Row) = "No"
Else
Range("K" & rng.Row) = ""
End If
Next rng
Application.EnableEvents = True
End If
However, if I try adding in the F range, nothing works:
If Not Intersect(Range("E12:E100"), Range("F12:F100"), Target) Is Nothing Then
Application.EnableEvents = False
For Each rng In Intersect(Range("E12:E100"), Range("F12:F100"), Target)
Set cellE = Range("E" & rng.Row)
Set cellF = Range("F" & rng.Row)
Set cellK = Range("K" & rng.Row)
If Range("E" & rng.Row) = "Configure" Then
Range("K" & rng.Row) = "No"
ElseIf Range("E" & rng.Row).Value Like "*Floor*" Then
Range("K" & rng.Row) = "No"
ElseIf Range("F" & rng.Row).Value Like "*Exa*" Then
'Range("K" & rng.Row) = "Not Needed"
Else
Range("K" & rng.Row) = ""
End If
Next rng
Application.EnableEvents = True
End If
Any help is greatly appreciated.
To better explain my comment:
column E never intersect Column F.
so your intersect will always fail, you are currently looking for the intersection of the three ranges, when you want the intersection of target with either of the two so you could use:
If Not Intersect(Range("E12:F100"), Target) Is Nothing Then
Application.EnableEvents = False
For Each rng In Intersect(Range("E12:F100"), Target)
Dim curRow as long
curRow = rng.Row
Set cellE = Range("E" & curRow)
Set cellF = Range("F" & curRow)
Set cellK = Range("K" & curRow)
If cellE = "Configure" Or cellE.Value Like "*Floor*" Then
cellK = "No"
ElseIf cellF .Value Like "*Exa*" Then
'cellK = "Not Needed"
Else
cellK = ""
End If
Next rng
Application.EnableEvents = True
End If
If you needed non contiguous ranges you could also use
`Intersect(Range("E12:E100","F12:F100"), Target)`
as this combines the two ranges into one
If Not Intersect(Range("E12:E100","F12:F100"), Target) Is Nothing Then
Application.EnableEvents = False
For Each rng In Intersect(Range("E12:E100","F12:F100"), Target)
Dim curRow as long
curRow = rng.Row
Set cellE = Range("E" & curRow)
Set cellF = Range("F" & curRow)
Set cellK = Range("K" & curRow)
If cellE = "Configure" Or cellE.Value Like "*Floor*" Then
cellK = "No"
ElseIf cellF .Value Like "*Exa*" Then
'cellK = "Not Needed"
Else
cellK = ""
End If
Next rng
Application.EnableEvents = True
End If