VBA to automate field updates

[RandomPanda]

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

[#2]

@RandomPanda 

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

[#3 · Accepted solution]

@RandomPanda 

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.

[#4]

@SnowMan55 

Thank you for this. I have revised to fit my file constraints and implemented and it works great!