Forum Discussion

RandomPanda's avatar
RandomPanda
Brass Contributor
Jun 13, 2024

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

  • 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.

  • NikolinoDE's avatar
    NikolinoDE
    Gold Contributor

    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 :smile:

     

  • SnowMan55's avatar
    SnowMan55
    Bronze Contributor

    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.

    • RandomPanda's avatar
      RandomPanda
      Brass Contributor

      SnowMan55 

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

Resources