Need a Macro to go to column named price and ADD 16% to each field

okief1122 · #1 08-28-2014, 10:09 AM

Can someone help give me a general overview of what i need to do to create a macro that would with a push of a button allow me to go to a column named PRICE in my spreadsheet no matter where it is as it may be in different locatations each time i do this and ADD 16% to each field I have created macros before and and have a general understanding but not totally sure what the the proper steps are.

excelledsoftware · #2 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

okief1122 · #3 08-30-2014, 11:20 PM

Thanks so much i will let you know how it works out

okief1122 · #4 09-06-2014, 10:16 PM

well am not as smart as I thought. 2 questions can you produce a vba app that would automate this and what would be your fees to create an app that will find the column named price and then add a specified percentage to each amount in that col. so i should be able to say what ever percentage, like 15% and then it would automatically add it to each field under the price column for example

%=.15

BEFORE
price
$10
$200

AFTER
price
$11.5
$230

excelledsoftware · #5 09-06-2014, 10:59 PM

fees? There are no fees this is all volunteer work and I am happy to do it. The modified code below can be placed in a module of your excel sheet and then you can call it whenever. This code will ask you for the percentage and then do the same thing as the last code.

Code:

Option Explicit

Sub SumPriceColumn()
  'Looks for a column named price and adds a specified percent to each row
  Dim CheckRow As Long, LastRow As Long, PriceColumn As Long, RowIssue As String
  Dim PricePercent As Single, PercentString As String, PercentConfirm 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
    PercentString = InputBox("What percent would you like to add to the " & _
    "values in column " & Chr(64 + PriceColumn) & ".")
    If PercentString = "" Then
      MsgBox "Nothing entered program is ending."
      End
    End If
    'convert the string to single
    On Error Resume Next
    PricePercent = CSng("1." & PercentString)
    If Err.Number <> 0 Then
      MsgBox "Cannot convert " & PercentString & " into a decimal. " & _
      vbLf & "Please try again using a whole number."
      End
    End If
    PercentConfirm = MsgBox("This will add " & PercentString & "% to all values in " _
    & "column " & Chr(64 + PriceColumn) & ". Do you want to proceed?", vbYesNoCancel)
    If PercentConfirm = vbNo Or PercentConfirm = vbCancel Then End

    
    'Use a loop to add specified percent to all values
    On Error GoTo NotaNumber
    For CheckRow = 2 To LastRow
      Cells(CheckRow, PriceColumn).Value = Round(Cells(CheckRow, PriceColumn).Value * PricePercent, 2)
    Next CheckRow

    If RowIssue = "" Then
      MsgBox "Complete"
      Exit Sub
    Else
      MsgBox "The following rows: " & RowIssue & " were not numbers and could not have " & _
      PercentString & "% 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

have fun let us know if it works out.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Excel: Item and Price	wchristner	Excel	2	07-21-2014 06:23 AM
Macro for Column to Rows Data	brunssl2	Excel Programming	3	04-28-2014 07:07 AM
Macro help - search for value, paste a value in another column	IRollman	Excel Programming	1	01-14-2014 01:05 PM
How to line up a merged field to a column heading	j_Southern	Mail Merge	2	10-08-2012 12:28 PM
Yearly price escalator?	markg2	Excel	1	04-15-2012 01:47 AM