Add currency to selected columns

Apple08

Active Member
Joined
Nov 1, 2014
Messages
450
Hi All

I have to add the currency format e.g. £1234.56 to those columns with Cost as part of the column headings in row 3. Once the row 3 has a word 'Cost' in the heading then the whole column from row 4 onwards will be in currency format as £1234.56. Start from column to the last unknown column.

I have done the code below but it doesn't work:

Code:
Sub convertCurrency()

Dim i As Long
Dim c As Long
Dim Lastrow As Long
Dim LastCol As Long
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
LastCol = Range("A1").End(xlToRight)
For c = 2 To LastCol
If Cells(4, c).Value Like "*Cost*" Then
    Cells(i, c).NumberFormat = "£###0.00"
    
End If
Next c


End Sub

Please could anyone help?
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Hello,

Inside your If instruction ... there is Cells(i,c) ... it looks like your row variable i is not defined ...
 
Upvote 0
Try
Code:
Sub convertCurrency()

   Dim c As Long
   Dim Lastrow As Long
   Dim LastCol As Long
   Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
   LastCol = Range("A1").End(xlToRight)
   For c = 2 To LastCol
      If Cells(3, c).Value Like "*Cost*" Then
          Range(Cells(4, c), Cells(Lastrow, c)).NumberFormat = "£###0.00"
      End If
   Next c
End Sub
 
Last edited:
Upvote 0
Try:
Rich (BB code):
Sub ConvertCCY()

    Dim x   As Long
    Dim r   As Range
    Dim rng As Range
    
    Const HeaderRow As Long = 3
    
    Set rng = Cells(HeaderRow, 1).Resize(, Cells(HeaderRow, Columns.Count).End(xlToLeft).Column)
    
    With Application
        x = .CountIf(rng, "*Cost*")
        .ScreenUpdating = False
    End With
    
    If x Then
        Set r = rng.Find(what:="*Cost*")
        For x = 1 To x
            r.EntireColumn.NumberFormat = "£###0.00"
            Set r = rng.Find(what:="*Cost*", after:=r)
        Next x
    End If
    
    Application.ScreenUpdating = True
    
    Set r = Nothing: Set rng = Nothing


End Sub
Adjust line in blue if required
 
Last edited:
Upvote 0
Sorry Fluff, I have tried yours but it didn't work.

Jack thanks for your code, it works perfectly.
 
Upvote 0
You're welcome

At a guess, Fluff's code may work with this row number change:
Rich (BB code):
LastCol = Range("A3").End(xlToRight)
 
Last edited:
Upvote 0
Good spot Jack, hadn't noticed that.
 
Upvote 0
I hadn't either after I changed 3 to START_ROW (with const) but hadn't changed .Resize part from 1 on test sheet was using. Easily happens.. to me anyway!
 
Upvote 0
Sorry guys, I have tried to use Fluff's code as I can easily amend it if the heading hasn't included 'Cost' then the number will be format without £. However it still doesn't work:

Code:
Sub convertCurrency()
   Dim c As Long
   Dim Lastrow As Long
   Dim LastCol As Long
   Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
   LastCol = Range("A3").End(xlToRight)
   For c = 2 To LastCol
      If Cells(3, c).Value Like "*Cost*" Then
          Range(Cells(4, c), Cells(Lastrow, c)).NumberFormat = "£###0.00"
      Else: Range(Cells(4, c), Cells(Lastrow, c)).NumberFormat = "###0.00"
      End If
   Next c
End Sub
 
Upvote 0
Try:
Code:
Sub ConvertCCY()

    Dim x   As Long
    Dim LC  As Long
    
    Const HeaderRow As Long = 3
    
    LC = Cells(HeaderRow, Columns.Count).End(xlToLeft).Column
    
    Application.ScreenUpdating = False
    
    For x = 1 To LC
        With Cells(1, x)
            .EntireColumn.NumberFormat = "###0.00"
            If InStr(LCase(.Value), "cost") Then .EntireColumn.NumberFormat = "£###0.00"
        End With
    Next x

    Application.ScreenUpdating = True

End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,621
Messages
6,120,563
Members
448,972
Latest member
Shantanu2024

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top