Microsoft Office Forums - View Single Post - Need a Macro to go to column named price and ADD 16% to each field

excelledsoftware · 08-30-2014, 08:49 PM

You need a couple things to happen. The first is finding the column that has the word price in it. That is done with

Code:

PriceColumn = range("1:1").find("PRICE").column

That will give you the column number. then you need to find the last row of the data so you can have a loop process it. I like to use

Code:

LastRow = cells(50000, PriceColumn).end(xlup).row

Once you have that data you can run your loop to add 16% to each field. Below is the entire code that should do this.

Code:

Option Explicit

Sub SumPriceColumn()
  'Looks for a column named price and adds 16% to each row
  Dim CheckRow As Long, LastRow As Long, PriceColumn As Long, RowIssue As String
    On Error Resume Next
    PriceColumn = Range("1:1").Find("PRICE", LookAt:=xlWhole, MatchCase:=False).Column
    'Tell user if price column was not found
    If PriceColumn = 0 Then
      MsgBox "There was no column in row 1 with the word Price"
      End
    End If
    On Error GoTo 0 'Fix error handling back to normal
    'Find the final row
    LastRow = Cells(50000, PriceColumn).End(xlUp).Row
    
    'Use a loop to add 16% to all values
    On Error GoTo NotaNumber
    For CheckRow = 2 To LastRow
      Cells(CheckRow, PriceColumn).Value = Cells(CheckRow, PriceColumn).Value * 1.16
    Next CheckRow

    If RowIssue = "" Then
      MsgBox "Complete"
      Exit Sub
    Else
      MsgBox "The following rows: " & RowIssue & " were not numbers and could not have 16% added" _
      & vbLf & "They have been highlighted red and skipped."
      Exit Sub
    End If
    
NotaNumber:
  Cells(CheckRow, PriceColumn).Interior.Color = vbRed
  RowIssue = RowIssue & CheckRow & ", "
  Resume Next
   
End Sub