• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Change currency format issue

Eloise T

Active Member
I am trying to emulate/imitate one of my fellow Chandooer's VBA constructs that corrected date formatting. I tried to make a VBA module that checks each row of Column H (starts with row 3) to make sure the currency is of the format "$#,##0"

I am getting an error message 91.

Please see attachment and CODE below. Thank you!
Code:
Sub CurrencyFix()
'  This Sub changes the Format of Column H from whatever it may be to: "$,##0" in which the currency is without decimals, one row at a time.
  Dim ws As Worksheet
  Dim lRow As Long, iColumn As Integer, lRowest As Long
'  start  1Row starts at row 3, iColumn starts at column H(8)
  lRow = 3
  iColumn = 8
'  process
  With ws
  lRowest = .Cells(.Rows.Count, iColumn).End(xlUp).Row
  Do While lRow <= lRowest
'  Debug.Print lRow
  With .Cells(lRow, iColumn)
'  If Len(.Cells(lRow, iColumn).Value) > 0 Then
  If .NumberFormat <> "$#,##0" Then .NumberFormat = "$#,##0"
  lRow = lRow + 1
  End With
  Loop
  End With
End Sub
 

Attachments

  • Chandoo - currency fix 2.xlsm
    116.8 KB · Views: 5
Last edited:
Hi, Eloise T!
In the other project/situation I didn't know a priori what type of data other than dates would contain the related column, so I went for a schema on a cell-by-cell basis. Actually I don't know why I did it in such way. o_O

In this case, if column E doesn't contain any other type of data, why not going for the simple:
Code:
    Columns("E:E").NumberFormat = "$#.##0"
since it doesn't hurt on blank cells?
Regards!
 
Hi, Eloise T!
In the other project/situation I didn't know a priori what type of data other than dates would contain the related column, so I went for a schema on a cell-by-cell basis. Actually I don't know why I did it in such way. o_O

In this case, if column E doesn't contain any other type of data, why not going for the simple:
Code:
    Columns("E:E").NumberFormat = "$#.##0"
since it doesn't hurt on blank cells?
Regards!
I agree!
Columns("E:E").NumberFormat = "$#.##0"
...makes a lot more sense. ...and being virtually VBA illiterate, I only say that as it looks like a whole lot less code to run.

Can I make "modules" THREE, FOUR and FIVE look a whole lot more like ONE and TWO?
The desired end result is to speed up the process. It takes about a minute and a half every time I run the VBA below:

Code:
Sub ChangeCase()
' ChangeCase is four VBA modules in one.  See Subs below: TRIMnCLEAN(), ChangeCase(), REDnBOLD(), and DateChange().
  Dim ws As Worksheet
  For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Formula Info" And ws.Name <> "Next Tech" Then
  'If ws.Name <> "Formula Info" And ws.Name <>"Next Tech" Then  Note: to add more just put (And ws.Name <> "name") before Then
'  Change "Formula Info" sheet name or you can use sheet index# instead of name.

  If ws.Cells(Rows.Count, 3).End(xlUp).Row > 2 Then
'  The 3 in (Rows.Count, 3) tells this Subroutine to start in the 3rd row.
'  This line was added to "fix" Error 400 which was caused by blank tab(s).
'  The "Next Tech" tab has no data, and its header is in row 2.
'  The part which returns the last row of data is:  ws.Cells(Rows.Count, 3).End(xlUp).Row
'  which will return 3 or more as long as the worksheet has data; thus subtracting 2 from
'  this value returns any number from 1 upwards.  However, when the worksheet has no data,
'  the above code will return 2, and subtracting 2 from this = 0, which is an invalid row
'  number in Excel.  To check this, we test whether the value returned by the above code
'  is greater than 2; if so, we proceed further, else we exit.
'ONE-------------------------------------
'  Sub TRIMnCLEAN()
  With ws.[A3:D3].Resize(ws.Cells(Rows.Count, 3).End(xlUp).Row - 2)
'  > > > This VBA removes leading and trailing spaces in the array of Columns A through D.
'  A3:D3 array tells where to apply change(s).  (Rows.Count, 3) tells in which column to start.
'  .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(#),"""")", "#", .Address)) yields only removing leading and trailing spaces.
'  Added CLEAN to remove leading and trailing ASCII characters 0-31.
  .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(CLEAN(#)),"""")", "#", .Address))
  End With
'  End Sub
'TWO-------------------------------------
'  Sub ChangeCase()
  With ws.[E3:F3].Resize(ws.Cells(Rows.Count, 3).End(xlUp).Row - 2)
'  > > > This VBA changes all characters in the array defined by Columns E and F to UPPER case.
'  E3:F3 array tells where to apply change(s).  (Rows.Count, 3) tells in which column to start.
  .Value = .Parent.Evaluate(Replace("IF(#>"""",UPPER(#),"""")", "#", .Address))
  End With
'  End Sub
'THREE----------------------------------- Immediate  ?workbooks.Count
'  Sub REDnBOLD()
  For Each cll In ws.Range(ws.Cells(3, "C"), ws.Cells(ws.Rows.Count, "C").End(xlUp)).Cells
'  > > > This VBA segment changes the TV Model screen size between 70 and 90 inches to red and Bold and
'  starts in Row 3, Column C, and applies to each tab in the Excel workbook, except for tab "Formula Info" tab.
  With cll
  x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
  If x > 0 Then
  y = CLng(Mid(cll.Value, x, 2))
  If y >= 70 And y <= 90 Then
  With .Characters(Start:=x, Length:=2).Font
  .FontStyle = "Bold"
  .Color = -16776961
  End With
  End If
  End If
  End With
  Next cll
'  End Sub
'FOUR-----------------------------------
'  Sub DateChange()
'  constants
'  Const ksFormat = "mm/dd/yyyy"
'  > > > This VBA segment changes the dates in Column G from whatever the format happens to be to "mm/dd/yyyy"
'  declarations
  Dim lRow As Long, iColumn As Integer, lRowest As Long
'  start  1Row starts at row 3, iColumn starts at column G(7)
  lRow = 3
  iColumn = 7
'  process
  With ws
  lRowest = .Cells(.Rows.Count, iColumn).End(xlUp).Row
  Do While lRow <= lRowest
'  Debug.Print lRow
  With .Cells(lRow, iColumn)
'  If Len(.Cells(lRow, iColumn).Value) > 0 Then
  If .NumberFormat <> "mm/dd/yyyy" Then .NumberFormat = "mm/dd/yyyy"
  lRow = lRow + 1
  End With
  Loop
  End With
'  end
'  End Sub
'FIVE------------------------------------  Columns("E:E").NumberFormat = "$#.##0"
'  Sub CurrencyFix()
  '  Dim lRow As Long, iColumn As Integer, lRowest As Long
  '  Dim ws As Worksheet
'  start  1Row starts at row 3, iColumn starts at column H(8)
  lRow = 3
  iColumn = 8
'  process
  With ws
  lRowest = .Cells(.Rows.Count, iColumn).End(xlUp).Row
  Do While lRow <= lRowest
'  Debug.Print lRow
  With .Cells(lRow, iColumn)
'  If Len(.Cells(lRow, iColumn).Value) > 0 Then
  If .NumberFormat <> "$#,##0" Then .NumberFormat = "$#,##0"
  lRow = lRow + 1
  End With
  Loop
  End With
'  End Sub
'BEEPS-----------------------------------
  End If
  End If
  Next
  Beep
'  Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
  Application.Wait Now + TimeValue("0:00:01")
  Beep
'  Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
  Application.Wait Now + TimeValue("0:00:01")
  Beep
End Sub
Sub Tabs_Colors_Off()
  Application.ScreenUpdating = False
  s_tab = Worksheets.Count
  For Each s In [{3,4,5,6,7,8,9,10,11,12,13,14,16,17,18}]  'To avoid an error message, these numbers must match the actual numbers of Tabs.
  Sheets(s).Tab.ColorIndex = xlNone
  Next s
End Sub
 
Last edited:
Hi, Eloise T!

I meant six-pack of Carlsberg... you know.:p

I'm giving a look to the whole code that you so kindly asked me to shrink as possible... but my eyes avoid being fixed on it. Let me see if I understood correctly all you're doing:
a) for all worksheets others than "Formula Info" & "Next Tech"
b) TRIMnCLEAN() removes leading/trailing spaces and remove non-printable characters (0-31) from columns A:D
c) ChangeCase() converts columns E:F to uppercase
d) REDnBOLD() paints column C for 70-90" (what about "Next Tech"?)
e) DateChange() I know this
f) CurrencyFix() formats column H as $#,##0

Questions:
1) each column holds a unique type of data?, i.e., all column cells has dates, or all has numbers, and so on.
2) title rows are all text?

Regards!
 
Hi, Eloise T!

I tried to do my best but please don't put me in this situation again, please. Thanks.

Code:
Option Explicit

Sub Tabs_Colors_Off()
    Dim s_tab As Integer, s As Variant
    Application.ScreenUpdating = False
    s_tab = Worksheets.Count
    For Each s In [{3,4,5,6,7,8,9,10,11,12,13,14,16,17,18}]  'To avoid an error message, these numbers must match the actual numbers of Tabs.
        Sheets(s).Tab.ColorIndex = xlNone
    Next s
End Sub
Sub NotMessi_ButLionel()
    ' constants
    ' declarations
    Dim ws As Worksheets, cll As Range
    Dim x As Integer, y As Long
    ' start
    ' process
    For Each ws In ThisWorkbook.Worksheets
        With ws
            If .Name <> "Formula Info" And .Name <> "Next Tech" Then
                '
                ' TRIMnCLEAN()
                With .[A3:D3].Resize(.Cells(Rows.Count, 3).End(xlUp).Row - 2)
                    ' > > > This VBA removes leading and trailing spaces in the array of Columns A through D.
                    ' A3:D3 array tells where to apply change(s).  (Rows.Count, 3) tells in which column to start.
                    ' .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(#),"""")", "#", .Address)) yields only removing leading and trailing spaces.
                    ' Added CLEAN to remove leading and trailing ASCII characters 0-31.
                    .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(CLEAN(#)),"""")", "#", .Address))
                End With
                '
                ' ChangeCase()
                With .[E3:F3].Resize(.Cells(Rows.Count, 3).End(xlUp).Row - 2)
                    ' > > > This VBA changes all characters in the array defined by Columns E and F to UPPER case.
                    ' E3:F3 array tells where to apply change(s).  (Rows.Count, 3) tells in which column to start.
                    .Value = .Parent.Evaluate(Replace("IF(#>"""",UPPER(#),"""")", "#", .Address))
                End With
                '
                ' REDnBOLD()
                For Each cll In ws.Range(ws.Cells(3, "C"), ws.Cells(ws.Rows.Count, "C").End(xlUp)).Cells
                    ' > > > This VBA segment changes the TV Model screen size between 70 and 90 inches to red and Bold and
                    ' starts in Row 3, Column C, and applies to each tab in the Excel workbook, except for tab "Formula Info" tab.
                    With cll
                        x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
                        If x > 0 Then
                            y = CLng(Mid(cll.Value, x, 2))
                            If y >= 70 And y <= 90 Then
                                With .Characters(Start:=x, Length:=2).Font
                                    .FontStyle = "Bold"
                                    .Color = -16776961
                                End With
                            End If
                        End If
                    End With
                Next cll
                '
                ' DateChange()
                ' > > > This VBA segment changes the dates in Column G from whatever the format happens to be to "mm/dd/yyyy"
                .Columns("G:G").NumberFormat = "mm/dd/yyyy"
                '
                ' CurrencyFix()
                ' > > > This VBA segment changes the amounts in Column H from whatever the format happens to be to "$#,##0"
                .Columns("H:H").NumberFormat = "$#,##0"
                '
            End If
        End With
    Next ws
    ' end
    MarcLBeepDemo
End Sub
Code:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function MarcLBeep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Boolean
#Else
    Private Declare Function MarcLBeep Lib "kernel32" Alias "Beep" (ByVal Frq As Long, ByVal Dur As Long) As Boolean
#End If

Sub MarcLBeepDemo()
Dim FD, L As Long
    FD = [{392,494,588,740,880,740,880;200,100,200,100,400,100,900}]
    For L& = 1 To UBound(FD, 2)
        MarcLBeep FD(1, L), FD(2, L)
    Next
End Sub
Regards!
 
Hi, Eloise T!

I meant six-pack of Carlsberg... you know.:p

I'm giving a look to the whole code that you so kindly asked me to shrink as possible... but my eyes avoid being fixed on it. Let me see if I understood correctly all you're doing:
a) for all worksheets others than "Formula Info" & "Next Tech"
b) TRIMnCLEAN() removes leading/trailing spaces and remove non-printable characters (0-31) from columns A:D
c) ChangeCase() converts columns E:F to uppercase
d) REDnBOLD() paints column C for 70-90" (what about "Next Tech"?) Don't worry about the "Next Tech" tab as that was a "test" tab that's being removed. The only tab that's different is the "Formula Info" tab. It's the first tab in the Wordbook if that matters.
e) DateChange() I know this
f) CurrencyFix() formats column H as $#,##0

Questions:
1) each column holds a unique type of data?, i.e., all column cells has dates, or all has numbers, and so on. Except for the title headers in rows 1 and 2, all Column cells have ordinary data. Columns A-D have names and serial numbers, Columns E and F have Y or N or N/A, Column G has dates and Column H has currency between $5 and $150.
2) title rows are all text? Correct.

Regards!
Hi, Eloise T!

I meant six-pack of Carlsberg... you know.:p

I'm giving a look to the whole code that you so kindly asked me to shrink as possible... but my eyes avoid being fixed on it. Let me see if I understood correctly all you're doing:
a) for all worksheets others than "Formula Info" & "Next Tech"
b) TRIMnCLEAN() removes leading/trailing spaces and remove non-printable characters (0-31) from columns A:D
c) ChangeCase() converts columns E:F to uppercase
d) REDnBOLD() paints column C for 70-90" (what about "Next Tech"?)
e) DateChange() I know this
f) CurrencyFix() formats column H as $#,##0

Questions:
1) each column holds a unique type of data?, i.e., all column cells has dates, or all has numbers, and so on.
2) title rows are all text?

Regards!
 
I apologize but Tab_Colors_Off should have not been in the mix. I snagged it in the wholesale copy-paste.

I appreciate all your work!
carlsberg-beer-6-pack__40000_zoom.jpg
 
Last edited:
@Eloise T
Hi!
Have I told you that we're falling in love with you? :):)
Thanks for the Carlsberg, but I don't find the link for uploading the voucher...
Regards!

@Marc L!
Hi!
I think that at Eloise T's kitchen, which surely is in Eloise T's home, do you have the address? We can share a cab from the airport, I guess...
Regards!
 
You guys are going to hate me...

I finally got a chance to replace the "old" code with SIRJB7's new code. This is what I'm getting when I "Debug" then "Compile VBAProject"

Compile error: Syntax error

upload_2017-7-28_18-9-53.png upload_2017-7-28_18-9-53.png
 
Hi, Eloise T!
Yes, you're right. What a wise person! How did you manage to figure it out?
That's the last version of the code? I don't recognize it at of mine edition.
Regards!

<Edited>
I've just uploaded my posted code into a blank module, compiled and didn't get any error. Verify the changes that you might have introduced or resume from my uploaded code.
 
Hi, Eloise T!
Yes, you're right. What a wise person! How did you manage to figure it out?
That's the last version of the code? I don't recognize it at of mine edition.
Regards!

<Edited>
I've just uploaded my posted code into a blank module, compiled and didn't get any error. Verify the changes that you might have introduced or resume from my uploaded code.
I am right about what? It sounds like you started the Carlsberg without me?

I believe it's all your code...but I will gladly try again. ...I've been at work since 8am Friday. It's now 5 minutes shy of midnight.
 
12:22 am. Figured it out! VBA works. Some data in one of the tabs was not correct apparently causing an endless loop. Not going to figure out exactly what data tonight. GOING HOME! Is the Carlsberg gone?
 
Hi, Eloise T!
Yes, you're right. What a wise person! How did you manage to figure it out?
That's the last version of the code? I don't recognize it at of mine edition.
Regards!

<Edited>
I've just uploaded my posted code into a blank module, compiled and didn't get any error. Verify the changes that you might have introduced or resume from my uploaded code.

I hate to ask (nothing that a 6 won't fix), but (speaking of 6) IF I wanted to have a 6th module to change the font and font size in Columns A3:H3 from whatever to Calibri and 11...how far off is this VBA code?
Code:
'Sub Calibri&11()
For Each cll In ws.Range(ws.Cells(3, "A:H"), ws.Cells(ws.Rows.Count, "A:H").End(xlUp)).Cells
                With cll
                    x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
                        If x > 0 Then
                            With .Characters(Start:=x, Length:=30).Font
                                    .Font.Name = "Calibri"
                                    .Font.Size = 11
                            End With
                        End If
                End With
                Next cll
'End Sub
 
Last edited:
Hi, Eloise T!

' start
I am right about what? It sounds like you started the Carlsberg without me?
...
It's now 5 minutes shy of midnight.
Let us go by parts, as Jack said in the London of the endings of XIX century...
About what? About this:
You guys are going to hate me...

' process
It sounds like you started the Carlsberg without me?
We, @Marc L and me, have been knocking at your front door for half and our and nobody answered... and when a guy nicely uniformed (or it was disguised?) came to the door we were told very rudely that you didn't live there. So we drove to the nearest pub and of course started without you.

' end
It's now 5 minutes shy of midnight.
What a particular and not enviable way of spending time on a Friday/Saturday night!

Regards!
 
Back
Top