Forum Discussion

RandomPanda's avatar
RandomPanda
Brass Contributor
Jun 13, 2024
Solved

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...
  • SnowMan55's avatar
    Jun 14, 2024

    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.

Resources