Solved

VBA To Change Cell Values If Certain Criteria Met

Posted on 2013-11-04
13
539 Views
Last Modified: 2013-11-13
Hello Experts -

I have the attached code that I need to update and I am not sure how to do it.

I need to change the pieces that look for the .001 or .999.

I need to look for any instance where the cell value rounded to the 3rd decimal place ends in .001 or .999.  If it does, then I need to change it end with either .002 or .998.

The number might be a positive or a negative number and may not be rounded at all, it could be .0008954 or something like that.

    For Each cell In rgsearch
        If IsError(cell.Value) Then
            xlws.Range(pbcol & cell.Row & ":" & pecol & cell.Row).ClearContents
        End If
        If Not IsNumeric(cell.Value) Or (cell.Value = "") Then
            'Debug.Print cell.Row
            xlws.Range(pbcol & cell.Row & ":" & pecol & cell.Row).ClearContents
        End If
        If (cell.Value > 0) And (cell.Value <= 0.001) Then
            cell.Value = 0.002
        End If
        If (cell.Value > 100) And (cell.Value <= 100.001) Then
            cell.Value = 100.002
        End If
        If (cell.Value < 0) And (cell.Value >= -0.001) Then
           cell.Value = -0.002
        End If
        If (cell.Value > 99.998) And (cell.Value <= 99.999) Then
            cell.Value = 99.998
        End If
    Next cell

Open in new window

0
Comment
Question by:rsburge
  • 8
  • 5
13 Comments
 
LVL 61

Expert Comment

by:mbizup
ID: 39622824
What you're describing sounds like string manipulation.

Try adding this where you need the formatting done:


Dim s as string

s = Right(FormatNumber(cell.Value, 3), 3)
If  s = "999" then Cell.Value = "" & Left(cell.Value, instr(1, Cell.Value, ".") & "998"
if s = "001" then Cell.Value = "" & Left(cell.Value, instr(1, Cell.Value, ".") & "002"

Open in new window

0
 

Author Comment

by:rsburge
ID: 39623016
Hi - This actually isn't working.

A specific example is the cell value is 0.000083549.  Rounded to the 3rd decimal place, this would be 0.001.

I need to change the cell value completely from 0.000083549 to 0.002.

Or, if the cell value were 100.999000201, then the cell value would need to change to 100.998.
0
 
LVL 61

Expert Comment

by:mbizup
ID: 39623254
Okay - see if this works (read the inline comments for my train of thought):

dim x as double

' round the cell value to three decimal places
x = round(cell.Value, 3)

'  x - int(x) gives you the decimal portion
select case (x - int(x))

     ' If the decimal portion is .999 update the cell to the int part + .998 decimal
     Case .999
          cell.Value = int(x) + .998

     ' If the decimal portion is .001 update the cell to the int part + .002 decimal
     Case .001
           cell.Value = int(x) + .002

     ' If it is neither, do nothing.  Select case block gives you room for more options
     Case Else
            ' do nothing

End Select

Open in new window

0
 
LVL 61

Expert Comment

by:mbizup
ID: 39623261
Just a note --

Your example doesn't look quite right:

<<
A specific example is the cell value is 0.000083549.  Rounded to the 3rd decimal place, this would be 0.001.
>>

 0.000083549 rounded to the 3rd decimal is actually zero.  Double-check your data and requirements - you'll have to use Round(x, 4) if you are really looking for .0001 for this number.
0
 

Author Comment

by:rsburge
ID: 39624769
Thank you.  The select case works if the cell value rounded to the 3rd place is exactly 0.001 or 0.999.

However, if the cell value rounded to the 3rd place is anything else, say 99.001 or 102.001 or 2.001 or 98.999, it doesn't work.
0
 
LVL 61

Assisted Solution

by:mbizup
mbizup earned 500 total points
ID: 39624903
Aha!  There's a floating point arithmetic error creeping in on the line that subtracts out the integer portion... so we need to round that expression to 3 decimal points too.

I've modified it below...

dim x as double

' round the cell value to three decimal places
x = round(cell.Value, 3)

'  x - int(x) gives you the decimal portion --- *** we need to round this result too.
select case  Round((x - int(x)), 3)

     ' If the decimal portion is .999 update the cell to the int part + .998 decimal
     Case .999
          cell.Value = int(x) + .998

     ' If the decimal portion is .001 update the cell to the int part + .002 decimal
     Case .001
           cell.Value = int(x) + .002

     ' If it is neither, do nothing.  Select case block gives you room for more options
     Case Else
            ' do nothing

End Select

Open in new window

0
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 

Author Comment

by:rsburge
ID: 39625051
Thank you!  I need to go to a meeting, but will test it when I get back in a few hours.
0
 
LVL 61

Expert Comment

by:mbizup
ID: 39625054
Sounds good
0
 
LVL 61

Accepted Solution

by:
mbizup earned 500 total points
ID: 39625076
Actually, the two rounds might be overkill.  You could probably do just this, only rounding after extracting the decimal portion:


dim x as double

' set x to hold the cell value
x =  cell.Value

'  x - int(x) gives you the decimal portion --- *** we need to round this to 3 decimal places
select case  Round((x - int(x)), 3)

     ' If the decimal portion is .999 update the cell to the int part + .998 decimal
     Case .999
          cell.Value = int(x) + .998

     ' If the decimal portion is .001 update the cell to the int part + .002 decimal
     Case .001
           cell.Value = int(x) + .002

     ' If it is neither, do nothing.  Select case block gives you room for more options
     Case Else
            ' do nothing

End Select

Open in new window

0
 

Author Comment

by:rsburge
ID: 39634438
I am so sorry for the delay.  We found out my mother in law has lung cancer and I completely forgot about this question.

The 2nd solution is working, but will try the last solution as well, then I will close this question.

Thank you for your help!
0
 
LVL 61

Expert Comment

by:mbizup
ID: 39634923
I'm very sorry to hear that!  Take your time, and no worries.
0
 

Author Closing Comment

by:rsburge
ID: 39643658
Thank you so much for your help and for your patience.

Both solutions work perfectly and there really is no difference in the amount of time it takes to run one versus the other.
0
 
LVL 61

Expert Comment

by:mbizup
ID: 39644192
Glad to help out :)
0

Featured Post

U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now