Loop in Excel Column A Find Like *Dollar* and Format Row as $$.00

[Vagus14]

Hey everyone,

I have a startup code that I found but I haven't been able to set it up to my required needs.

In VBA I want to do the following:
1. I want to: Search the workbook in column A for something like the word "*Dollars*.
2. The code locates which rows have the keyword dollars and formats the whole row to currency.

I've gotten started a little bit but I get a run-time error:

Sub MM1()
Dim i As Long
Columns("A:A").NumberFormat = "#,##0"
For i = 1 To Rows.Count
Next i
[COLOR=red]If Cells(i, 1).Value = "*dollar*" And Not IsEmpty(Cells(i, 1).Value) Then
[/COLOR]Cells(i, 1).NumberFormat = "$#,##0.00"
End If
End Sub

 

[Rx_]

This code run from Access to control Excel remotely. So, remove the
ObjXL. everywhere
intMaxRecordCount is total records and intRowPos is where the data row starts.
In this example: .Cells(i - 1, "B").Value is checking the row above the current row to see if they are the same, if not Row B through L get bolded.
.Cells(i, "B").Value could be checked for value, format or anything else.
If the word "dollar" is literally there, it could be used to remove that string then refresh (replace) only the numeric and then format the new value as currrency.

1670    With ObjXL.ActiveWorkbook.ActiveSheet
          'objxl.ActiveWorkbook.ActiveSheet
1680      For i = intRowPos To intMaxRecordCount + intRowPos
1690          If .Cells(i, "B").Value <> .Cells(i - 1, "B").Value Then
1700              .Range(.Cells(i, "B"), .Cells(i, "L")).Font.FontStyle = "Bold"
                  '.Cells(i, 33).Value = .Cells(i, 3).Value
1710          Else
1720               .Range(.Cells(i, "B"), .Cells(i, "L")).Font.ColorIndex = 16 'metalic gray
1730          End If
1740      Next i
1750  End With

Here is a slight variation used in another custom report. I build all reports in Excel from Access code.
Rember the old Green Bar computer paper?
This has a twist. Every time the Primary item changes in B - it creates a greenbar on that line, then white until the item changes again.
Makes the reading easier.

1720        OtherColor = True
1730        With ObjXL.ActiveWorkbook.ActiveSheet
1740            For i = intRowPos To intMaxRecordCount + intRowPos
1750             If .Cells(i, "B").Value <> .Cells(i - 1, "B").Value Then
                       '.Range(.Cells(i, "B"), .Cells(i, "H")).Font.FontStyle = "Bold"
                       '.Cells(i, 33).Value = .Cells(i, 3).Value
1760                   OtherColor = Not OtherColor ' this activates the every other group for greenbar
1770             Else
1780                  If OtherColor Then
                       '.Range(.Cells(i, "B"), .Cells(i, "C")).Font.ColorIndex = 16 'metalic gray to column B
1790                    .Range(.Cells(i, "B"), .Cells(i, "X")).Interior.ThemeColor = xlThemeColorAccent3 ' light green bar to column U
1800                    .Range(.Cells(i, "B"), .Cells(i, "X")).Interior.TintAndShade = 0.799981688894314
1810                    .Range(.Cells(i - 1, "B"), .Cells(i - 1, "X")).Interior.ThemeColor = xlThemeColorAccent3 ' light green bar to column U for first instance
1820                    .Range(.Cells(i - 1, "B"), .Cells(i - 1, "X")).Interior.TintAndShade = 0.799981688894314
1830                  Else
                        '.Range(.Cells(i, "B"), .Cells(i, "C")).Interior.ThemeColor = xlThemeColorAccent1
                        '.Range(.Cells(i, "B"), .Cells(i, "C")).Font.ColorIndex = 16 'metalic gray
1840                  End If
                 
1850             End If
1860           Next i
1870        End With

Do an advanced search on my user name Rx_ with excel and you might find more code examples. This should hopefully help you get started.

 

[Vagus14]

Operating System: Windows 7
Software: Microsoft Excel 2010 and Access 2010

Sorry about not being more clear before. I have gotten it to work in Excel perfectly with help. Now I want to use this code below in Access 2010:

Function RowsAddDollar()
    Dim i As Long
 
    Columns("B").Delete xlShiftToLeft
    Columns("B:B").EntireColumn.AutoFit
    Columns("A:R").NumberFormat = "#,##0"
    For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
        If Cells(i, 2).Value Like "*Dollars*" Then Rows(i).NumberFormat = "$#,##0.00"
    Next i
End Function

However I am getting an error when I try and convert it to Access based code:

It just freezes and doesn't execute.

 Function Ten()
Set xlApp = CreateObject("Excel.Application")
        Dim i As Long
        With xlApp
        Set wb = .Workbooks.Open("D:\CLIN Summary.xlsx")
        Set ws = wb.Sheets(1)
        Const xlUp = -4121
 
            xlApp.Visible = True
            .ScreenUpdating = False
 
    ws.Columns("B").Delete xlShiftToLeft
    ws.Columns("B:B").EntireColumn.AutoFit
    ws.Columns("A:R").NumberFormat = "#,##0"
 
    For i = 1 To ws.Range("B" & ws.Rows.Count).End(xlUp)
        If ws.Cells(i, 2).Value Like "*Dollar*" Then ws.Rows(i).NumberFormat = "$#,##0.00"
    Next i
 
    End With
End Function

I appreciate all your support.

 

[Rx_]

Ah, you fell for the myth of the Lone Ranger! Range is a Worksheet object. But, it is not a lone cell. A Range object can be a single cell, a rectangular block of cells, or the union of many rectangular blocks (a non-contiguous range). A Range object is contained within a Worksheet object.

It is going to be something you run into later. Let me suggest you read this:
http://msdn.microsoft.com/en-us/library/office/aa139976(v=office.10).aspx
Even us old programmers fall for this one. And, it is hard to troubleshoot when the error is at this level.
Notice what I did on my loop (didn't show the code). Create a variable to obtain your actual numbers for a loop. In other words, use object code to assign the number for your for-next. Then use that variable in the for-next. If your variable ends up being Null or some wild number, it is a whole lot easier to step through the code and find something like the Range object failing than to figure out the code.
It won't affect the efficiency of the code at run-time. But, it will simplify troubshooting for the human required element.

Here is another example of setting the range and setting the last row to a variable:
LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row - 3
Hope that helps.

[COLOR=#00008b]Sub[/COLOR] Highlight()
    [COLOR=darkblue]Dim[/COLOR] f%
    [COLOR=darkblue]Dim[/COLOR] ws     [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] rngData [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Const[/COLOR] StartRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR] = 5
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] ws [COLOR=darkblue]In[/COLOR] Worksheets(Array("Direct Activities", "Enhancements", "Indirect Activities", "Overheads", "Projects"))
        LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row [B]- 3[/B]
        [COLOR=darkblue]If[/COLOR] LastRow >= StartRow [B]+ 1[/B] [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]Set[/COLOR] rngData = ws.Range(ws.Cells(StartRow, 3), ws.Cells(LastRow, 14))
            [COLOR=darkblue]For[/COLOR] f = 1 [COLOR=darkblue]To[/COLOR] rngData.Columns.Count
                [B][COLOR=darkblue]If[/COLOR] WorksheetFunction.Count(rngData.Columns(f)) >= 2 [COLOR=darkblue]Then[/COLOR][/B]
                    rngData.Cells(WorksheetFunction.Match(WorksheetFunction.Large(rngData.Columns(f), 1), rngData.Columns(f), 0), f).Font.ColorIndex = 3
                    rngData.Cells(WorksheetFunction.Match(WorksheetFunction.Large(rngData.Columns(f), 2), rngData.Columns(f), 0), f).Font.ColorIndex = 5
                [B][COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR][/B]
            [COLOR=darkblue]Next[/COLOR] f
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        ws.Columns("B:Q").AutoFit
    [COLOR=darkblue]Next[/COLOR] ws
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Unsolicited Tip: Realizing this is only a code segment, be sure and add Error Trapping. For Automation, an error is leaving an Orphan Excel application running in memory.
To manually check, start up Task Manager and see how many copies of Excel.exe are running. Post that as a different question as Excel Automation running from Access Error Trapping. There are some tricks of the trade a little more specific.
My application run on Citrix. If my Excel automation failed daily for 50 users, that could be a lot of resources being wasted.

 

[Vagus14]

Hey Rx, still having issues with the code below. I took a look at the code you provided and info and can't seem to figure out a means to implement. Thanks for your continued help. Anyone know a solution?

With Columns I am getting a Run-time error 1004 and with Cells I am getting a Object not defined error. Thanks!

Option Explicit
Function Ten()
Const xlUp = -4121
Dim xlApp As Object
Dim wb As Object
Dim ws As Object
Dim I As Long
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.ScreenUpdating = False
Set wb = .Workbooks.Open("D:\CLIN Summary.xlsx")
End With
 
Set ws = wb.Sheets(1)
ws.Columns("B:B").EntireColumn.AutoFit
ws.Columns("A:R").NumberFormat = "#,##0"
For I = 1 To ws.Range("C" & ws.Rows.Count).End(xlUp).Row
If [COLOR=red]ws.Columns[/COLOR](I, 3).Value Like "*Dollar*" Then
ws.Rows(I).NumberFormat = "$#,##0.00"
End If
Next I
End Function