if statment based on cell format

[bujaman]

I am trying to select the cells that meet a couple of criteria, the value has to be greater than 0 and formatted as currency. I have tried the following with no success. Any suggestions?

If cell.Value > 0 And Selection.NumberFormat = "$#,##0.00" Then 
'do stuff
End If

 

[shg]

Maybe ...

If VarType(cell.Value) = vbDouble And InStr(cell.Text, "$") > 0 Then

 

[Scott Huish]

Perhaps:

If IsNumeric(cell) And cell > 0 And cell.Text = Format(cell, "Currency") Then
    MsgBox "All Criteria Met"
End If

 

[bujaman]

Thank you for the quick response, Hotpepper, you solution is working. Now I have another question with this if statement. The IF is inside a For Each statement that goes through each cell in a defined range. I need to activate each cell as I go through and do various thing based on each cell value. How do I activate the cell that the IF statement is examining?

 

[Scott Huish]

You don't need to activate or select cells in VBA to work with them, you can work with cells directly. What are you trying to do?

 

[bujaman]

I am trying to sort data from one worksheet to another. My source worksheet has pricing data broken into months (columns in the allData range) and various activities (Rows). I am trying to search through the allData range and if there is a price listed, copy various information from the source worksheet to the summarysheet, and arrange it into columns so that each cost has its own row. Here is what I have so far for code:

Sub sendtosummary()

Dim allData As Range
Dim NewLastRow As Long
Dim summarysheet As Worksheet
Dim actcell As Range

Worksheets("Data").Activate

Set allData = Worksheets("Data").Range("M3:AJ6")
Set summarysheet = Worksheets("Cost Summary")
Range("M3").Activate
Application.ScreenUpdating = False

For Each cell In allData

If IsNumeric(cell) And cell > 0 And cell.Text = Format(cell, "Currency") Then
   

    'Copy hours and cost
    
    Set actcell = ActiveCell
    Worksheets("Data").Activate
    ActiveCell.Select
    Selection.Copy
    Worksheets("Cost Summary").Activate
    NewLastRow = Range("A65536").End(xlUp).Row
    summarysheet.Cells(NewLastRow + 1, 6).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Worksheets("Data").Activate
    ActiveCell.Offset(0, 1).Select
    Selection.Copy
    Worksheets("Cost Summary").Activate
    NewLastRow = Range("A65536").End(xlUp).Row
    summarysheet.Cells(NewLastRow + 1, 7).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'Copy Date
    Worksheets("Data").Activate
    Cells(1, ActiveCell.Column - 1).Copy
    Worksheets("Cost Summary").Activate
    NewLastRow = Range("A65536").End(xlUp).Row
    summarysheet.Cells(NewLastRow + 1, 5).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'Copy Employeer Class and Name from Summary to Cost Summery
    Worksheets("Data").Activate
    Range("C" & ActiveCell.Row).Select
    ActiveCell.Copy
    Worksheets("Cost Summary").Activate
    NewLastRow = Range("A65536").End(xlUp).Row
    summarysheet.Cells(NewLastRow + 1, 3).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Worksheets("Data").Activate
    Range("D" & ActiveCell.Row).Select
    ActiveCell.Copy
    Worksheets("Cost Summary").Activate
    NewLastRow = Range("A65536").End(xlUp).Row
    summarysheet.Cells(NewLastRow + 1, 4).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


    'Copy WBS from Summary to Cost Summery
    Worksheets("Data").Activate
    Range("B" & ActiveCell.Row).Select
    ActiveCell.Copy
    Worksheets("Cost Summary").Activate
    NewLastRow = Range("A65536").End(xlUp).Row
    summarysheet.Cells(NewLastRow + 1, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Worksheets("Data").Activate
 
End If
Next cell

Application.ScreenUpdating = True
End Sub

I am having trouble getting it to work properly. I am sure there are better ways to do this, but I am pretty green when it comes to VBA. Thanks for your help, I really appreciate it!

 

[bujaman]

OK, I figured it out, I needed to use Cell, not ActiveCell when referencing the cell the code was examining. Thanks for the help!

 

[Scott Huish]

You still don't need to select the cell in order to work with it:

For example:

Instead of:

 ActiveCell.Select
    Selection.Copy

Just work with the cell directly:

ActiveCell.Copy

 

[bujaman]

Thanks, that makes sense now. Thank you for the help, I appreciate it.