Forum Discussion
VBA to automate field updates
I am looking for some generic VBA code that will allow me to automatically adjust a couple fields based on others for a set number of lines. What I want, in laymen's terms is:
1. Pop-up to enter the number of "lots" (see screenshot) I want to adjust
2. For that many lots, adjust column F to add the amount in G (F is currently not a formula, so manually, I do an "<F2>, +1, <Home>, =, <tab>" - I want it to do this so I can see the new formula versus just adding the fields like in another VBA project I have).
3. For the same amount of lots, I need to adjust the weight in col P by adding the number in G * the average weight in col Q. Again, P is not a formula now, so I manually do "<F2>, +1*219, <Home>, =, <tab>
From my limited experience writing these I assume it would look similar to this:
X = entered number of lots (array)
Diff = col G
Avg = col Q
For x lots, F = F+Diff
For x lots, P = P+Diff*Avg
The lot number, which could be utilized to define/compare X is in column D. So, we could use an "If col D is IN the entered lot array" - say I enter 1 as the starting and 9 as the ending lot in the pop-up - THEN ... run the formulas. This way, if I want to adjust, say lots 16-22 or only lot 40, the IF-statement will only look for and adjust those lots. So, the beginning and ending lots should be able to be the same number. And, the search for lot numbers should be D2-D60 with error handling for no entry (I generally have 35-50 lots, but could be more or less).
Thank you in advance
To accomplish the content replacement while including error (exception) handling and a summary of rows changed, try the following:
Sub ReplaceLotValues() ' This procedure (macro) prompts for a range of Lot numbers (the ' first and last Lot numbers can be the same, to act upon a ' single lot), and changes the Hogs counts (column F) and ' Total Weights (column P) for those rows, replacing them with ' formulas. Dim strMessage As String Dim in4UserResponse As VbMsgBoxResult ' Dim objWorksheet As Worksheet Dim in2FirstLotNumber As Integer Dim in2LastLotNumber As Integer ' Dim rngCell As Range Dim in2LotNumber As Integer Dim vntDifference As Variant Dim vntAvgWeight As Variant Dim vntHogs As Variant Dim vntTotalWeight As Variant ' Dim in2RowsModified As Integer '---- Prepare for error handling. Set rngCell = Range("A1") '...temporarily, to simplify error handling On Error GoTo RLV_ErrHndlr '---- Get confirmation of which worksheet is to be used. Set objWorksheet = ActiveSheet in4UserResponse = MsgBox("Do you want to use and modify worksheet " _ & objWorksheet.Name & "?" _ , vbQuestion + vbYesNo + vbDefaultButton2) If in4UserResponse = vbNo Then Call MsgBox("Activate the correct worksheet, and try again." _ , vbInformation) Exit Sub End If '---- Prompt the user for the range of Lot numbers. With Application in2FirstLotNumber = .InputBox("Enter the first relevant Lot number:" _ , Type:=1) in2LastLotNumber = .InputBox("Enter the last relevant Lot number:" _ , Type:=1) End With ' -- Check for invalid input. If in2FirstLotNumber = 0 Or in2LastLotNumber = 0 Then '...the user likely canceled the action. Call MsgBox("Action canceled at your request.", vbInformation) Exit Sub ElseIf in2FirstLotNumber < 0 Or in2LastLotNumber < 0 _ Or in2LastLotNumber > 3000 Then Call MsgBox("Please enter valid Lot numbers.", vbExclamation) Exit Sub ElseIf in2LastLotNumber < in2FirstLotNumber Then Call MsgBox("Please enter Lot numbers in ascending order (i.e.," _ & " the smaller one first).", vbExclamation) Exit Sub End If '---- Loop through the rows to find the specified Lot numbers. Where ' those are found, change columns F and P. For Each rngCell In objWorksheet.Range("D2:D60") '[Feel free to increase the last row number, as the performance ' penalty for checking extra rows is negligible.] in2LotNumber = rngCell.Value '[That assumes the Lot number cells all 'contain numbers < 32768 or are empty.] If in2LotNumber >= in2FirstLotNumber _ And in2LotNumber <= in2LastLotNumber Then vntHogs = rngCell.Offset(0, 2).Value '(column F) vntDifference = rngCell.Offset(0, 3).Value '(column G) vntTotalWeight = rngCell.Offset(0, 12).Value '(column P) vntAvgWeight = rngCell.Offset(0, 13).Value '(column Q) ' -- Check the relevant cells for no content/invalid content. If IsEmpty(vntHogs) _ Or IsNumeric(vntHogs) = False _ Or IsEmpty(vntDifference) _ Or IsNumeric(vntDifference) = False _ Or IsEmpty(vntTotalWeight) _ Or IsNumeric(vntTotalWeight) = False _ Or IsEmpty(vntAvgWeight) _ Or IsNumeric(vntAvgWeight) = False _ Then Call MsgBox("Incomplete or invalid data was found for Lot " _ & in2LotNumber & vbCrLf & vbCrLf _ & "No change will be made to that row." _ , vbExclamation + vbOKOnly) GoTo NextRow End If ' -- Replace the content of columns F and P with formulas. rngCell.Offset(0, 2).Formula = "=" & vntHogs & " + " & vntDifference rngCell.Offset(0, 12).Formula = "=" & vntTotalWeight _ & " + " & vntDifference & " * " & vntAvgWeight ' -- in2RowsModified = in2RowsModified + 1 End If NextRow: Next rngCell RLV_Exit: Call MsgBox(in2RowsModified & " rows were updated.", vbInformation + vbOKOnly) Exit Sub RLV_ErrHndlr: Dim in4ErrorCode As Long Dim strErrorDescr As String ' -- Capture information about the processing error (exception). in4ErrorCode = Err.Number strErrorDescr = Err.Description ' -- Notify the user. strMessage = "Error " & in4ErrorCode & " occurred" If rngCell.Address = "$A$1" Then strMessage = strMessage & ":" Else strMessage = strMessage & "while processing worksheet row " _ & rngCell.Row & ":" End If strMessage = strMessage & vbCrLf & strErrorDescr in4UserResponse = MsgBox(strMessage, vbCritical) ' -- Resume RLV_Exit End Sub
I recommend including an Option Explicit statement at the beginning of this—and every—code module that you use. And as with any macro-enabled workbook, be very careful in who you allow to edit it.
- NikolinoDEGold Contributor
Sub AdjustFieldsBasedOnLots() Dim startLot As Integer, endLot As Integer Dim cell As Range Dim ws As Worksheet Dim lotNumber As Integer Dim lotRange As Range Dim diff As Double Dim avgWeight As Double ' Prompt user for starting and ending lot numbers startLot = Application.InputBox("Enter the starting lot number:", Type:=1) endLot = Application.InputBox("Enter the ending lot number:", Type:=1) ' Error handling for invalid inputs If startLot <= 0 Or endLot <= 0 Or endLot < startLot Then MsgBox "Please enter valid lot numbers.", vbExclamation Exit Sub End If Set ws = ThisWorkbook.Sheets("Sheet1") ' Change Sheet1 to your sheet name ' Loop through the rows to find the specified lots and adjust columns F and P For Each cell In ws.Range("D2:D60") ' Adjust range as needed lotNumber = cell.Value If lotNumber >= startLot And lotNumber <= endLot Then diff = cell.Offset(0, 3).Value ' Column G avgWeight = cell.Offset(0, 13).Value ' Column Q ' Update column F If IsNumeric(cell.Offset(0, 2).Value) Then ' Ensure it's a numeric value cell.Offset(0, 2).Formula = "=" & cell.Offset(0, 2).Value & "+" & diff End If ' Update column P If IsNumeric(cell.Offset(0, 12).Value) Then ' Ensure it's a numeric value cell.Offset(0, 12).Formula = "=" & cell.Offset(0, 12).Value & "+" & diff & "*" & avgWeight End If End If Next cell MsgBox "Fields updated successfully!", vbInformation End Sub
The code is not tested, please back up your file beforehand.
Maybe it will help. Maybe not
- SnowMan55Bronze Contributor
To accomplish the content replacement while including error (exception) handling and a summary of rows changed, try the following:
Sub ReplaceLotValues() ' This procedure (macro) prompts for a range of Lot numbers (the ' first and last Lot numbers can be the same, to act upon a ' single lot), and changes the Hogs counts (column F) and ' Total Weights (column P) for those rows, replacing them with ' formulas. Dim strMessage As String Dim in4UserResponse As VbMsgBoxResult ' Dim objWorksheet As Worksheet Dim in2FirstLotNumber As Integer Dim in2LastLotNumber As Integer ' Dim rngCell As Range Dim in2LotNumber As Integer Dim vntDifference As Variant Dim vntAvgWeight As Variant Dim vntHogs As Variant Dim vntTotalWeight As Variant ' Dim in2RowsModified As Integer '---- Prepare for error handling. Set rngCell = Range("A1") '...temporarily, to simplify error handling On Error GoTo RLV_ErrHndlr '---- Get confirmation of which worksheet is to be used. Set objWorksheet = ActiveSheet in4UserResponse = MsgBox("Do you want to use and modify worksheet " _ & objWorksheet.Name & "?" _ , vbQuestion + vbYesNo + vbDefaultButton2) If in4UserResponse = vbNo Then Call MsgBox("Activate the correct worksheet, and try again." _ , vbInformation) Exit Sub End If '---- Prompt the user for the range of Lot numbers. With Application in2FirstLotNumber = .InputBox("Enter the first relevant Lot number:" _ , Type:=1) in2LastLotNumber = .InputBox("Enter the last relevant Lot number:" _ , Type:=1) End With ' -- Check for invalid input. If in2FirstLotNumber = 0 Or in2LastLotNumber = 0 Then '...the user likely canceled the action. Call MsgBox("Action canceled at your request.", vbInformation) Exit Sub ElseIf in2FirstLotNumber < 0 Or in2LastLotNumber < 0 _ Or in2LastLotNumber > 3000 Then Call MsgBox("Please enter valid Lot numbers.", vbExclamation) Exit Sub ElseIf in2LastLotNumber < in2FirstLotNumber Then Call MsgBox("Please enter Lot numbers in ascending order (i.e.," _ & " the smaller one first).", vbExclamation) Exit Sub End If '---- Loop through the rows to find the specified Lot numbers. Where ' those are found, change columns F and P. For Each rngCell In objWorksheet.Range("D2:D60") '[Feel free to increase the last row number, as the performance ' penalty for checking extra rows is negligible.] in2LotNumber = rngCell.Value '[That assumes the Lot number cells all 'contain numbers < 32768 or are empty.] If in2LotNumber >= in2FirstLotNumber _ And in2LotNumber <= in2LastLotNumber Then vntHogs = rngCell.Offset(0, 2).Value '(column F) vntDifference = rngCell.Offset(0, 3).Value '(column G) vntTotalWeight = rngCell.Offset(0, 12).Value '(column P) vntAvgWeight = rngCell.Offset(0, 13).Value '(column Q) ' -- Check the relevant cells for no content/invalid content. If IsEmpty(vntHogs) _ Or IsNumeric(vntHogs) = False _ Or IsEmpty(vntDifference) _ Or IsNumeric(vntDifference) = False _ Or IsEmpty(vntTotalWeight) _ Or IsNumeric(vntTotalWeight) = False _ Or IsEmpty(vntAvgWeight) _ Or IsNumeric(vntAvgWeight) = False _ Then Call MsgBox("Incomplete or invalid data was found for Lot " _ & in2LotNumber & vbCrLf & vbCrLf _ & "No change will be made to that row." _ , vbExclamation + vbOKOnly) GoTo NextRow End If ' -- Replace the content of columns F and P with formulas. rngCell.Offset(0, 2).Formula = "=" & vntHogs & " + " & vntDifference rngCell.Offset(0, 12).Formula = "=" & vntTotalWeight _ & " + " & vntDifference & " * " & vntAvgWeight ' -- in2RowsModified = in2RowsModified + 1 End If NextRow: Next rngCell RLV_Exit: Call MsgBox(in2RowsModified & " rows were updated.", vbInformation + vbOKOnly) Exit Sub RLV_ErrHndlr: Dim in4ErrorCode As Long Dim strErrorDescr As String ' -- Capture information about the processing error (exception). in4ErrorCode = Err.Number strErrorDescr = Err.Description ' -- Notify the user. strMessage = "Error " & in4ErrorCode & " occurred" If rngCell.Address = "$A$1" Then strMessage = strMessage & ":" Else strMessage = strMessage & "while processing worksheet row " _ & rngCell.Row & ":" End If strMessage = strMessage & vbCrLf & strErrorDescr in4UserResponse = MsgBox(strMessage, vbCritical) ' -- Resume RLV_Exit End Sub
I recommend including an Option Explicit statement at the beginning of this—and every—code module that you use. And as with any macro-enabled workbook, be very careful in who you allow to edit it.
- RandomPandaBrass Contributor
Thank you for this. I have revised to fit my file constraints and implemented and it works great!