vba check for negative value - vba

I wrote a simple VBA code to check if the value of a cell is negative and if it is negative, highlight it red. For some reason, I keep getting "run-time mismatch". My code is
For x = 2 To 100
Set val3 = Worksheets("Summary").Cells(x, 9)
If val3.Value < 0 Then
Worksheets("Summary").Cells(x, 9).FontColorIndex = 3
End If
Next x
Column 9 (the column I am checking) is filled with dollar values. Thank you in advance for your help.

In your code, you're simply missing a dot.
FontColorIndex = 3
should be:
Font.ColorIndex = 3

Public Sub test()
For x = 2 To 100
Set val3 = Worksheets("Sheet1").Cells(x, 9)
If val3.Value < 0 Then
Worksheets("Sheet1").Cells(x, 9).Font.Color = RGB(99, 179, 73)
End If
Next x
End Sub
Code above works in excel 2007

Thanks for your post, I needed to change the negative numbers to zeros after a certain process - BUT I want to check them before I use them so changing the font color is useful, so this code works well for the whole sheet range until (245,50)
Sub negnumbers()
For x = 1 To 245
For y = 1 To 50
Set val3 = Worksheets("target sheet").Cells(x, y)
If val3.Value < 0 Then
Worksheets("target sheet").Cells(x, y).Font.ColorIndex = 3
Worksheets("target sheet").Cells(x, y) = 0
End If
Next y
Next x
End Sub

Related

Excel VBA: "Next Without For" Error

I am getting the "next without for" error. I checked other questions on this and looked for any open if statements or loops in my code, but could find none. I'm need an extra set of eyes to catch my error here.
I am trying to loop through this code and advance the torque value 3 times each times it gets to the 30th i.
'This is Holzer's method for finding the torsional natural frequency
Option Explicit
Sub TorsionalVibrationAnalysis_()
Dim n As Integer 'position along stucture
Dim m As Integer
Dim i As Long 'frequency to be used
Dim j As Variant 'moment of inertia
Dim k As Variant 'stiffness
Dim theta As Long 'angular displacement
Dim torque As ListRow 'torque
Dim lambda As Long 'ListRow 'omega^2
Dim w As Variant
Dim s As Long
'equations relating the displacement and torque
n = 1
Set j = Range("d2:f2").Value 'Range("d2:f2").Value
Set k = Range("d3:f3").Value
'initial value
Set w = Range("B1:B30").Value
For i = 1 To 30
'start at 40 and increment frequency by 20
w = 40 + (i - 1) * 20
lambda = w ^ 2
theta = 1
s = 1
Do While i = 30 & s <= 3
torque = lambda * j(1, s)
s = s + 1
End
m = n + 1
theta = theta - torque(i, n) / k(n)
torque(i, m) = torque(i, n) + lambda * j(m) * theta
If m = 4 & i < 30 Then
w(i) = 40 + (i - 1) * 20
lambda = w(i) ^ 2
ElseIf m = 4 & i >= 30 Then
Cells([d], [5+i]).display (i)
Cells([e], [5+i]).display (theta)
Cells([f], [5+i]).display (torque)
Else
End If
If m <> 4 Then
n = n + 1
End If
Next i
End Sub
You are trying to terminate your While with an End instead of Loop
Try changing your End to Loop in your Do While loop. I think you are terming the loop when you hit that End
Proper indentation makes the problem rather apparent.
You have:
For i = 1 To 30
'...
Do While i = 30 & s <= 3
'...
End
'...
If m = 4 & i < 30 Then
'...
ElseIf m = 4 & i >= 30 Then
'...
Else
End If
If m <> 4 Then
'...
End If
Next i
But run it through Rubberduck's Smart Indenter and you get:
For i = 1 To 30
'...
Do While i = 30 & s <= 3
'...
End
'...
If m = 4 & i < 30 Then
'...
ElseIf m = 4 & i >= 30 Then
'...
Else
End If
If m <> 4 Then
'...
End If
Next i
End Sub
Notice how the End other answers are pointing out, is clearly not delimiting the Do While loop.
The Next i is inside the Do While block, which isn't terminated - when the VBA compiler encounters that Next i, it doesn't know how it could possibly relate to any previously encountered For statement, and thus issues a "Next without For" compile error.
Use an indenter.

Excel VBA: "Too many different cell formats" - Is there a way to remove or clear these formats in a Macro?

So, I made a fun and simple macro that randomly selects R, G, and B values until it uses every possible combination (skipping repeats), and setting the color values of a 10x10 square with each new color.
The only problem is that I have run into the limit for the number of cell formats. Microsoft says that the limit should be around 64000, but I found it to be exactly 65429 on a blank workbook in Excel 2013.
I've included a clear format code, but it seems to have no effect:
Cells(X, Y).ClearFormats
Microsoft lists some resolutions, but 3 out of the 4 of them are essentially "Don't make too many formats", and the 4th format is to use a third party application.
Is there really nothing that can be done in VBA?
A1:J10 will print a new color
K1 will print the percentage to completion
L1 will print the number of colors used
M1 will print the number of times a color combination is repeated
Dim CA(255, 255, 255) As Integer
Dim CC As Long
Dim RC As Long
Dim R As Integer
Dim G As Integer
Dim B As Integer
Dim X As Integer
Dim Y As Integer
CC = 0
RC = 0
X = 1
Y = 1
Do While ColorCount < 16777216
R = ((Rnd * 256) - 0.5)
G = ((Rnd * 256) - 0.5)
B = ((Rnd * 256) - 0.5)
If CA(R, G, B) <> 1 Then
CA(R, G, B) = 1
'Step down to the next row
'If at the 10th row, jump back to the first and move to the next column
If X < 10 Then
X = X + 1
Else
X = 1
If Y < 10 Then
Y = Y + 1
Else
Y = 1
End If
End If
Cells(X, Y).ClearFormats 'doesn't do what I hope :(
Cells(X, Y).Interior.Color = RGB(R, G, B)
CC = CC + 1
Cells(1, 11).Value = (CC / 16777216) * 100
Cells(1, 12).Value = CC
Else
RC = RC + 1
Cells(1, 13).Value = RC
End If
Loop
There are several ways to resolve this issue, but the cleanest and easiest method is to remove all extra styles (I have seen workbooks with 9000+ styles )
With the following simple VBA code you can remove all non-builtin styles and in the vast majority of cases this fixes the error.
Sub removeStyles()
Dim li as long
On Error Resume Next
With ActiveWorkbook
For li = .Styles.Count To 1 Step -1
If Not .Styles(li).BuiltIn Then
.Styles(li).Delete
End If
Next
End With
End Sub

Code either overloads memory or wont compile VBA

Trying to write a macro to insert a hyphen at specific points in a text string depending on how long the string is or delete all text after said point.
i.e
- if 6 characters, insert a hyphen between char 4+5 or delete all text after char 4
- if 7 characters, insert a hyphen between char 5+6 or delete all text after char 5
Ideally i would love to be able to truncate the string at that point rather than hyphenate the text but i couldn't get my head around how to make it work so i decided to hyphen and then just run a find and replace '-*' to remove the unwanted characters. Can get this working on small sample sets 100-300 cells but i need the code to be able to go through workbooks with 70,000+ cells. I've tried tweaking the code to stop the memory issue but now i can't seem to get it to work.
Sub Postcodesplitter()
Dim b As Range, w As Long, c As Range, x As Long, d As Range, y As Long
For Each b In Selection
w = Len(b)
If w = 8 And InStr(b, "-") = 0 Then b = Application.WorksheetFunction.Replace(b, 15 - w, 0, "-")
For Each c In Selection
x = Len(c)
If x = 7 And InStr(c, "-") = 0 Then c = Application.WorksheetFunction.Replace(c, 13 - x, 0, "-")
For Each d In Selection
y = Len(d)
If y = 6 And InStr(d, "-") = 0 Then d = Application.WorksheetFunction.Replace(d, 11 - y, 0, "-")
Next
Next
Next
End Sub
That's the original code i put together, but it caused memory issues over 300 target cells. I'm a pretty bad coder even at the best of times but with some advice from a friend i tried this instead.
Sub Postcodesplitter()
Dim b As Range, x As Long
If (Len(x) = 6) Then
b = Application.WorksheetFunction.Replace(b, 11 - x, 0, "-")
Else
If (Len(x) = 7) Then
b = Application.WorksheetFunction.Replace(b, 13 - x, 0, "-")
Else
If (Len(x) = 8) Then b = Application.WorksheetFunction.Replace(b, 15 - x, 0, "-")
End Sub
But this just throws out errors when compiling. I feel like im missing something really simple.
Any tips?
It looks as though you want to truncate to two less than the existing number of characters, if that number is 6-8? If so, something like this:
Sub Postcodesplitter()
Dim data
Dim x as Long
Dim y as Long
data = Selection.Value
For x = 1 to ubound(data,1)
for y = 1 to ubound(data, 2)
Select Case Len(data(x, y))
Case 6 to 8
data(x, y) = left(data(x, y), len(data(x, y)) - 2)
end select
next y
next x
selection.value = data
End Sub

VBA Excel automatic colour and value change

I am trying to set up a personal management spreadsheet for work. I have a list of tasks with varying priority.
What I am trying to do here is if the number of tasks * priority goes hits certain thresholds the colour of the availability cells changes and the description cell value changes, eg "busy"
here is the code I have so far, how do I implement it to change automatically when I change the value of the task list
Sub Avail_flag()
TasksRange = ActiveSheet.Range("P3:P6")
availcells = Range("M8,N8")
busyflag = 0
medBusyFlag = 0
highBusyFlag = 0
imedBusyFlag = 0
If Range("p4") > 0 Then
medBusyFlag = 1
ElseIf Range("p4") > 2 Then
medBusyFlag = 2
ElseIf Range("p5") > 0 Then
highBusyFlag = 1
ElseIf Range("p5") > 2 Then
highBusyFlag = 2
ElseIf Range("p6") > 0 Then
imedBusyFlag = 1
End If
For Each sell In lRange
busyflag = (medBusyFlag + (highBusyFlagI * 2) + (imedBusyFlag * 3))
If busyflag > 0 Then
For Each cell In Range(availcells)
cell.Color = green
Next
cell("N8").Value = "Occupied"
ElseIf busyflag > 3 Then
For Each cell In Range(availcells)
cell.Color = orange
Next
cell("N8").Value = "Busy"
ElseIf busyflag > 5 Then
For Each cell In Range(availcells)
cell.Color = red
Next
cell("N8").Value = "Unavailable"
Else
For Each cell In Range(availcells)
cell.Color = white
End If
End Sub
here is a capture of the spreadsheet if that helps, the highlighted grey part is where all the magic happens
You can use the Change event for the sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
I went for conditional formatting, something I hadn't heard of before. After looking it up and learning how to use it it seem to be by far the best option. Thank you #mehow for the usggestion

Next without For Error while formatting a worksheet

I am new to VBA. I am trying to run a formatting check on a sheet.
The error is Next without For error. What I am trying to do is to check columns H and O from rows number 33 to 58 for number formatting error. It shows error at "Next n".
The code is like this:
Public Sub PercentageCheck()
Dim CTRYname As String
Dim x As Integer
Dim n As Integer
Dim m As Integer
For n = 1 To 13
CTRYname = ThisWorkbook.Sheets("Country lookup").Range("A1").Offset(n, 0).Value
For m = 33 To 58
For x = 8 To 15
If x = 9 Or x = 10 Or x = 11 Or x = 12 Or x = 13 Or x = 14 Then
GoTo Names
Else
wkbCurr.Sheets(CTRYname).Activate
If IsNumeric(wkbCurr.Sheets(CTRYname).Cells(x, m).Value) Then
If wkbCurr.Sheets(CTRYname).Cells(x, m).Value > 9.99 Then
wkbCurr.Sheets(CTRYname).Cells(x, m).Value = ">999%"
ElseIf wkbCurr.Sheets(CTRYname).Cells(x, m).Value < -9.99 Then
wkbCurr.Sheets(CTRYname).Cells(x, m).Value = "<-999%"
End If
End If
Names:
Next x
Next m
Next n
End Sub
Can you help with suggestions for a better way to check it.
Second question first: suggest a better way to check it.
Answer: be diligent with indenting. This easily revleals the missing line of code
Public Sub PercentageCheck()
Dim CTRYname As String
Dim x As Integer
Dim n As Integer
Dim m As Integer
For n = 1 To 13
CTRYname = ThisWorkbook.Sheets("Country lookup").Range("A1").Offset(n, 0).Value
For m = 33 To 58
For x = 8 To 15
If x = 9 Or x = 10 Or x = 11 Or x = 12 Or x = 13 Or x = 14 Then
GoTo Names
Else
wkbCurr.Sheets(CTRYname).Activate
If IsNumeric(wkbCurr.Sheets(CTRYname).Cells(x, m).Value) Then
If wkbCurr.Sheets(CTRYname).Cells(x, m).Value > 9.99 Then
wkbCurr.Sheets(CTRYname).Cells(x, m).Value = ">999%"
ElseIf wkbCurr.Sheets(CTRYname).Cells(x, m).Value < -9.99 Then
wkbCurr.Sheets(CTRYname).Cells(x, m).Value = "<-999%"
End If
End If
' ---> Missing End If
Names:
Next x
Next m
Next n
End Sub
BTW, the GoTo Names is not necassary in this code. And neither is wkbCurr.Sheets(CTRYname).Activate. Just leave them out and the code works the same.
Update:
Based on your comment and the bug it revealed, I suggest you use more meaningful variable names. This will help avoid this kind of error. Also, prudent use of With can make your code more readable (and faster)
Here's a refactored version to demonstrate
Public Sub PercentageCheck()
Dim CTRYname As String
Dim col As Integer
Dim n As Integer
Dim rw As Integer
For n = 1 To 13
CTRYname = ThisWorkbook.Sheets("Country lookup").Range("A1").Offset(n, 0).Value
With wkbCurr.Sheets(CTRYname)
For rw = 33 To 58
For col = 8 To 15
If col < 9 Or col > 14 Then
With .Cells(rw, col)
If IsNumeric(.Value) Then
If .Value > 9.99 Then
.Value = ">999%"
ElseIf .Value < -9.99 Then
.Value = "<-999%"
End If
End If
End With
End If
Next col, rw
End With
Next n
End Sub
You're missing an END IF for your If x = 9 Or x = 10 Or x = 11 Or x = 12 Or x = 13 Or x = 14 Then ... Else ...
Indent your code to improve readability and this sort of thing will become somewhat self-evident. #chris-neilsen's example is excellent.
Counting opening statements, compared to closing statements will help at a pinch (and is what I did to debug your code in this instance).
Using an IDE that highlights corresponding start/end symbols would also help you (but I'm not sure what IDE's are available for VBA macros... if anything).