Forum Discussion
VBA
Hello,
I have a simple excel table with three columns, Current, Replaced, and New.
The Current column contains a specific date.
The Replaced column contains either Yes or No.
If the Replaced column has an entry of No, the date from the Current column will be written into the New column.
If the Replaced column has an entry of Yes, an input box prompt will write the users entry into the New column.
This is the VBA code.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim tbl As ListObject
Dim N As Range
Dim C As Range
Dim R as Range
Set tbl = ActiveSheet.ListObjects(1)
Set N = tbl.ListColumns("New").DataBodyRange
Set C = tbl.ListColumns("Current").DataBodyRange
Set R = tbl.ListColumns("Replaced").DataBodyRange
'If R = "No" Then ***This give a Type Mismatch runtime error and is not currently in code, but was tried***
If Range("F2") = "No" Then ***This does not give any errors***
N = C.Value
Else
N = InputBox("Please enter City, State, and ZIP of site address", "Entry is required")
End If
Application.EnableEvents = True
End Sub
This code kind of works as intended but with two problems I am looking for help with.
Problem 1: A type mismatch error is received when trying to use the line highlighted in red.
Since there can be multiple rows within the table and the number of rows will be unknown and vary in total, I cannot define a specific range as in the example code, I need the Replaced column to be looked at for the entire table.
Problem 2: with the example code, if there are 4 rows in the table, all 4 rows of the New column are written to when F2 changes between Yes and No.
I need the New column to have a value written to it based off of the Yes No entry for each row, not from one single row.
I hope these questions make sense.
Thanks in advance for any suggestions.
chowell97 To get a cell in an adjacent column of the table, use syntax like this:
Change this line:
Set N = tbl.ListColumns("New").DataBodyRange
to:
Set N = Intersect(tbl.ListColumns("New").DataBodyRange, Target.EntireRow)
You can now use n.Value to get the value of the New column on the same row as the changed cell (Target).
Adjust the other lines accordingly.
4 Replies
- SnowMan55Bronze Contributor
Jan's technique works if the user changes only one cell at a time. But if the user changes multiple cells at once (e.g., by dragging the contents of a cell down in the Replaced column), that technique processes only the top of the changed rows (specifically, it uses only the first cell within Target).
It's also true that your existing/modified code recalculates the New value when columns in your table other than Current or Replaced are modified (or even if a cell outside the table is modified, if it's in a row shared by a table data row).
Consider this code instead:Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim tbl As ListObject Dim rngChgdCurrentCells As Range Dim rngChgdReplacedCells As Range Dim rngChgdRelevantCells As Range Dim rngCell As Range Dim in4Row As Long Dim N As Range 'the "New" cell for a row Dim C As Range 'the "Current" cell for a row Dim R As Range 'the "Replaced" cell for a row Dim strUserResponse As String '---- On Error GoTo WkshtChg_ErrHndlr '---- In "the table" [description?], calculate/recalculate the ' New value in rows where either the Current value or the ' Replaced value changed. ' -- Determine if any of the changed cells are relevant to ' the calculation of a New value. Set tbl = ActiveSheet.ListObjects(1) Set rngChgdCurrentCells = Intersect(Target, _ tbl.ListColumns("Current").DataBodyRange) Set rngChgdReplacedCells = Intersect(Target, _ tbl.ListColumns("Replaced").DataBodyRange) If rngChgdCurrentCells Is Nothing _ And rngChgdReplacedCells Is Nothing Then '...the changed cell(s) is/are not relevant. GoTo WkshtChg_Exit End If ' -- Load references to all relevant changed cells into a ' single variable. If rngChgdCurrentCells Is Nothing Then Set rngChgdRelevantCells = rngChgdReplacedCells ElseIf rngChgdReplacedCells Is Nothing Then Set rngChgdRelevantCells = rngChgdCurrentCells Else '...(it's unlikely, but) both types of cells were changed. Set rngChgdRelevantCells = Union( _ rngChgdCurrentCells, rngChgdReplacedCells _ ) End If ' -- Examining each changed relevant cell, calculate a New value ' in the same row. For Each rngCell In rngChgdRelevantCells in4Row = rngCell.Row Set C = Intersect(rngCell.EntireRow, tbl.ListColumns("Current").DataBodyRange) Set R = Intersect(rngCell.EntireRow, tbl.ListColumns("Replaced").DataBodyRange) Set N = Intersect(rngCell.EntireRow, tbl.ListColumns("New").DataBodyRange) ' If IsEmpty(R.Value) Then '...Replaced value has not been entered. Do nothing. [?] ElseIf R.Value = "No" Then ' [...use that for a case-sensitive test; if case does not matter, use: 'ElseIf StrComp(R.Value, "No", vbTextCompare) = 0 Then N.Value = C.Value Else 'Because "Entry is required", prompt until a non-empty response is 'received. Do strUserResponse = InputBox("Please enter City, State, and ZIP of" _ & " site address", "Entry is required") Loop Until Len(strUserResponse) > 0 N.Value = strUserResponse End If Next rngCell WkshtChg_Exit: Application.EnableEvents = True Exit Sub WkshtChg_ErrHndlr: Dim in4ErrorCode As Long Dim strErrorDescr As String Dim strMessage As String Dim in4UserResponse As VbMsgBoxResult ' -- Capture info about the processing error. in4ErrorCode = Err.Number strErrorDescr = Err.Description ' -- Notify the user. strMessage = "Error " & in4ErrorCode & " occurred while processing row " _ & Format$(in4Row, "#,###,##0") & vbCrLf & strErrorDescr in4UserResponse = MsgBox(strMessage, vbRetryCancel) ' -- If in4UserResponse = vbRetry Then Resume Else Resume WkshtChg_Exit End If End Sub
I've included an example of a simple error handler.
Note that your test for "No" is case-sensitive. I included commented-out code for an alternative, case-insensitive test.I also wrapped the prompt for site address in a Do loop, as the prompt title indicates "Entry is required". (But as written, the user could defeat this by just entering a space.)
And let me point out that it is generally poor design to put multiple types of values into one table column, as you have done putting both a date value and a site address into New. This may be completely functional, but it may also make future usage and/or modifications more difficult.- chowell97Copper ContributorThank you for the additional information including the error handler example.
Also, thank you for pointing out the multiple types of values I was referencing.
This was actually a line of code copied from another worksheet that writes address information into different table columns and was not corrected for this particular table prior to posting.
- JKPieterseSilver Contributor
chowell97 To get a cell in an adjacent column of the table, use syntax like this:
Change this line:
Set N = tbl.ListColumns("New").DataBodyRange
to:
Set N = Intersect(tbl.ListColumns("New").DataBodyRange, Target.EntireRow)
You can now use n.Value to get the value of the New column on the same row as the changed cell (Target).
Adjust the other lines accordingly.
- chowell97Copper ContributorThank you Jan, this so far has corrected my issues.