I am trying to divide all the cells in a selection by 1000 but not cells which have a sum formula.
Criteria:
Cell must have a number.
Cell should not contain the Sum() formula (any other formula is okay).
If both of these criteria are met then divide the cell value by 1000.
For Each cell In Selection.Cells
If IsNumeric(cell) = False Or cell.Address = Left(ActiveCell.Formula, 5) = "=Sum(" Or cell.Address = Left(ActiveCell.Formula, 6) = "=+SUM(" Or cell.Address = Left(ActiveCell.Formula, 6) = "=-SUM(" Then
MsgBox ("Selection either does contain numbers or has only sum formulae")
Else
cell.value = cell.value / 1000
End If
Next
Not sure what you're trying to achieve with
Cell.Address = Left(ActiveCell.Formula,5) = "=Sum(
You can only compare one value with another.
I'm sure the more advanced people here will frown on the way I phrased the if statement but it does the job:
Sub divideBy1000()
Dim formCheck As Variant
For Each ccell In Selection.Cells
Debug.Print (ccell.Formula)
Debug.Print (ccell.Value)
formCheck = InStr(ccell.Formula, "SUM(") 'This checks if SUM is in the formula and returns a value bigger than 0 if so (where it occurs in the string).
If len(trim(ccell.value2))>0 Then
If IsNumeric(ccell.Value) And (formCheck = Null Or formCheck = 0) Then
'You have to use AND so none of the SUM formulas get through, no else needed this way
If Left$(ccell.Formula, 1) = "=" Then 'EDIT to keep your formula
ccell.Formula = "=(" & Right$(ccell.Formula, Len(ccell.Formula) - 1) & ")/1000"
Else
ccell.Value = ccell.Value / 1000
End If
End If
End If
Next ccell
End Sub
Edit:
Added a catch for empty cells so they don't turn to 0 and added Instr to check for the SUM as suggested by #Marcucciboy2
Related
I have some very basic VBA code here
sub HideRows_Based_On_Values
For Each cell in Range (C12:AG37)
if cell.value = "SD" or "SA" or "SN" then cell.entirerow.hidden = false
else cell.entirerow.hidden = true
next cell
End Sub
The range is correct, the inputs in the cells are correct.
For some reason, excel is hiding some (not all) of the rows that have at least one of these values present in them. I can't figure out what I'm doing wrong.
I expected for the code to filter out any rows that don't have one of SD, SA, or SN present - but it's only working on some of the rows and not all.
Not:
A = 1 OR 2 OR 3
But:
(A = 1) OR (A = 2) OR (A = 3)
This is true in every computer program, computer programming language, ...
I've been testing until it worked and this is what I came up with:
Sub HideRows_Based_On_Values()
For Each cell In Range("C12:AG37")
If ((cell.Value = "SD") Or (cell.Value = "SA") Or (cell.Value = "SN")) Then
cell.EntireRow.Hidden = False
Else: cell.EntireRow.Hidden = True
End If
Next cell
End Sub
The weird part is that, next to the range where you need double quotes (Range("C12:AG37")), you need to put the action of the Then on the next line, otherwise it won't work.
Before:
After:
Edit:
Hereby the solution, as provided by the author of the question:
Sub HideRows_Based_On_Values()
For Each Row In Range("C12:AG37").Rows
If Application.CountIf(Row, "SD") + Application.CountIf(Row, "SA") + Application.CountIf(Row, "SN") = 0 Then
Row.Hidden = True
Else Row.Hidden = False
End If
Next Row
End Sub
sub HideRows_Based_On_Values
For Each cell in Range (C12:AG37)
if cell.value = "SD" OR cell.value = "SA" OR cell.value = "SN" then
cell.entirerow.hidden = false
else
cell.entirerow.hidden = true
end if
next cell
End Sub
I'd like to find if any row in Column C matches any cells in Column A or B and print out 'yes' or 'no' in an adjacent cell if it does match. The match might not be exact, because an ID may be written as '12401' but the match in the column may be like 'cf[12401]', with the ID enclosed in brackets.
This is an example of what I might find in the table. The values in A and B columns originally came from another table but I'm trying to find all instances of where they might exist in the third column.
Excel Example:
If possible, I'd like to list the values themselves that matched in the column. But that part would be a nice extra while the other part is more important because there are around 6000 values in the middle column so it would take days by hand.
I've tried different things like this:
=IF(COUNTIF(C2,"*" & A6 & "*" ), "Yes", "No")
or
=IF(COUNTIF(C2,"*" & Length & "*" ), "Yes", "No")
these work for individual words or cells, but trying to check all the values in that column against the cell will return no. I've tried variations of SUMPRODUCT and others that I've found, but haven't been able to get something that works for multiple values.
Is there some function in Excel that will allow me to do this? Or maybe a way in VBA?
Here is some UDF you could use.
Dim MyArr As Variant, X As Double, LR As Double
Option Explicit
Public Function MatchID(RNG As Range) As String
With ActiveWorkbook.Sheets(RNG.Parent.Name)
LR = .Cells(Rows.Count, 1).End(xlUp).Row
MyArr = Application.Transpose(.Range(.Cells(2, 1), .Cells(LR, 1)))
For X = LBound(MyArr) To UBound(MyArr)
If InStr(1, RNG.Value, MyArr(X), vbTextCompare) > 0 Then
If MatchID = "" Then
MatchID = MyArr(X)
Else
MatchID = MatchID & ", " & MyArr(X)
End If
End If
Next X
End With
End Function
Public Function MatchCFNAME(RNG As Range) As String
With ActiveWorkbook.Sheets(RNG.Parent.Name)
LR = .Cells(Rows.Count, 1).End(xlUp).Row
MyArr = Application.Transpose(.Range(.Cells(2, 2), .Cells(LR, 2)))
For X = LBound(MyArr) To UBound(MyArr)
If InStr(1, RNG.Value, MyArr(X), vbTextCompare) > 0 Then
If MatchCFNAME = "" Then
MatchCFNAME = MyArr(X)
Else
MatchCFNAME = MatchCFNAME & ", " & MyArr(X)
End If
End If
Next X
End With
End Function
In D2 Ijust used =IF(F2<>"","YES","") and dragged it sideways and down.
I am currently using this basic code to divide the value of a cell by 1000:
Sub Divide_by_1000()
Dim cell As Range
For Each cell In Selection
cell = cell / 1000
Next
End Sub
Whilst it works very well for hard-coded numbers, if used on a cell with a formula in it, it removes the formula and outputs a number.
Ideally, I would like the macro to work as it does for a cell with a number in it, but for a cell with a formula I would like it to wrap brackets around the current formula and put a /1000 at the end (i.e. keeping the formula in tact)
I believe there will need to be a test to check if the cell has a formula in it first and apply the code I already have if it doesn't and the code I outlined above if it does.
Any help would be much appreciated.
You can check if the cell has a formula by checking if the first character is a equal sign =
If Left$(cell.Formula, 1) = "=" Then
or even better
If cell.HasFormula Then
and then rewrite the formula extended by ( … )/1000
cell.Formula = "=(" & Right$(cell.Formula, Len(cell.Formula) - 1) & ")/1000"
also I recommend to check if the cell.Value is a number before you divide by 1000
ElseIf IsNumeric(cell.Value) Then
cell.Value = cell.Value / 1000
So you end up with something like
If Left$(cell.Formula, 1) = "=" Then
cell.Formula = "=(" & Right$(cell.Formula, Len(cell.Formula) - 1) & ")/1000"
ElseIf IsNumeric(cell.Value) Then
cell.Value = cell.Value / 1000
End If
Note while this will work for normal formulas, it will crush eg array formulas.
After comments with #PEH:
You can use .HasFormula and .HasArray to test for the formula type
If cell.HasFormula Then
If cell.HasArray Then
cell.Offset(0, 1).FormulaArray = "=(" & Right$(cell.FormulaArray, Len(cell.FormulaArray) - 1) & ")/1000"
Else
cell.Offset(0, 1).Formula = "=(" & Right$(cell.Formula, Len(cell.Formula) - 1) & ")/1000"
End If
ElseIf IsNumeric(cell.Value2) Then
cell.Offset(0, 1).Value2 = cell.Value2 / 1000
End If
A range/cell can be checked for formulas using the HasFormula property e.g.
Dim TheArea as range
Set TheArea = range("some name")
If TheArea.HasFormula then
' All the cells in the range have a formula
End if
alternatively you could use the specialcells property of a range e.g.
For Each Cell In TheArea.SpecialCells(xlCellTypeConstants)
Cell.Value = cell.Value/1000
Next Cell
For Each Cell In TheArea.SpecialCells(xlCellTypeFormulas)
Cell.Formula = "=(" & Right$(Cell.Formula, Len(Cell.Formula) - 1) & ")/1000"
Next Cell
This approach also gives you the opportunity to detect other possible scenarios e.g. xlCellTypeBlanks if they are important to you. The full list of special cells can be found here ...
https://learn.microsoft.com/en-us/office/vba/api/excel.range.specialcells
I am attempting to copy results from another sheet based on the cell values on the active worksheet. i.e loop through every element in array "GWworkStations()" and find a match in column B of "Col List" sheet, and then copy the corresponding values in "C:E" to an array "MatchedEntries" so I can copy them back to the active sheet.
The code is returning empty for "matchedRow", instead of reporting the row number. I am not getting an error.
dim MatchedEntries() as string
dim GWworkStations() as variant
number_of_rows = ActiveSheet.UsedRange.Rows.Count
With ActiveWorkbook.Worksheets("New Sheet")
GWworkStations() = range("B2:B" & number_of_rows)
End With
ReDim MatchedEntries(1 To r) 'Size the array to hold the results.
'for every cell that is not empty in GWworkStations(), search through column B of 'Col List ' sheet.
For i = 1 To number_of_rows
'matchedRow = Empty
On Error Resume Next 'Keep running if Excel MATCH function below doesn't find a match.
If Not IsEmpty(Cells(i, 1)) Then
matchedRow = Application.WorksheetFunction.Match(GWworkStations(i, 1), range("Col List!B:B"), 0)
If matchedRow = Empty Then Debug.Print "Empty " & matchedRow
If IsEmpty(matchedRow) Then 'No match.
MatchedEntries(i, 1) = "" 'GWworkStations(i, 1)
Else
'If GWworkStations(i, 1) = GWworkStations(i - 1) Then
If IsNumeric(matchedRow) Then 'Match was found.
MatchedEntries(i, 1) = Application.WorksheetFunction.Index(range("List!C:E"), matchedRow, 1)
Else 'MATCH function returned a non-numeric result.
MatchedEntries(i, 1) = ""
End If 'IsNumeric(MatchedRow)
End If 'IsEmpty(MatchedRow)
Else
End If
Next i
range("E2:G" & number_of_rows) = MatchedEntries() 'Write the tag name results out to range E:G.
Excel doesn't like the space in the sheet name. You can fix this by using single quotes: Range("'Col List'!B:B"), or by replacing Range("Col List!B:B")with Sheets("Col List").Columns(2).
You could also use the Range.Find method (which I would prefer):
matchedRow = Sheets("Sheet 3").Columns(2).Find(str).Row
I have numerical values entered in Row 1 from columns A to IA. I want to create a loop that compares one cell with the cell before it (aka Cell B1 to A1 or cell F to E). Let's use B1 and A1 as the example. It looks at the Value in Cell B1 and sees if it is greater then the value of the cell in A1. If it is greater then I want a + to be entered in the Cell B2. Also if B1 is < A1 put a - into Cell B2. I want the program to be able to loop this process so it does it for all the columns A-AI. Below is what I want want the program to do (not including the dashes and teh paranthesis around the positive and negative signs of course).
A B C D F
1 33.12 34.52 34.92 35.19 34.97
2 (+) (+) (+) (-)
I realize this task is easily performed in excel (not using VBA) but I am trying to learn VBA so I can perform much more complex tasks. I have written the basic code to do the simple task but I am not sure how to loop it so it will do this for all my cells!
Sub EnterFormula()
Dim x As Integer
Dim y As Integer
x = Worksheets("Sheet2").Range("C2").Value
y = Worksheets("Sheet2").Range("B2").Value
If x > y Then
Worksheets("Sheet2").Range("C4") = "+"
End If
End Sub
Ok So for the next part of My Program. It gets a touch more complicated. We move onto row 3. Row 3 is going to either have a U (for Up) or a D (for down) or nothing.
Let's Start at Column C. Column C1 has a value of 34.92, and C2 was given a + (as 34.92 was larger then the day before which was 33.02). Now we go to the first previous "+" WITH AT LEAST one opposite sign (in this case "-") in between. So in this case that is row A (one "-" inbetween under row B). Now if the Numerical Value in C1 (34.92) is larger then the numerical value in A (33.12) then we designate a "U" in C3. If it was NOT larger we would leave an empty cell in C3.
Let's move onto column D. Column D1 has a value of 35.19 which is greater then the C1 value of 34.92 and this is why D2 has a "+". Next we go to the first previous "+" WITH AT LEAST one opposite sign (in this case "-") in between. So in this case that is row A again. Since the numerical value in D1 (39.19) is greater then the numerical value in A1 (33.12) then D3 gets a U.
Moving onto Column F (32.97)...Note:I changed the value a little from the original F. 32.97 is LESS then 35.19 (D1) which is why F2 is a "-". Next we go to the first previous "-" WITH AT LEAST one opposite sign (in this case "+") in between. So in this case this is Row B (with two "+" signs in between). Now because we are dealing with "-" signs this time we look and see if the numerical value in F1 is LESS then the numerical value in B1...which it is, so a "D" is entered in F3. If F1 was larger then B1 then the cell would be left empty.
Onto Column G (35.21). This is greater then 32.97 (F1) and therefore gets a "+" in G2. Next we go to the first previous "+" WITH AT LEAST one opposite sign in between (in this case "-"). So in this case this is Row D (with one "-" in between). Since the numerical value of G1 is greater then that of D1 we designate a "U". If it was not greater we would leave the cell empty.
A B C D F G H I
1 33.12 33.02 34.92 35.19 32.97 35.21 35.60 35.90
2 (+) (-) (+) (+) (-) (+) (+) (+)
3 U U D U U U
Here is my code so far for this. I have added to my original code which was creating the "+" signs and "-" signs.
Sub Comparison()
Dim targetCell As Range
Dim targetSignCell As Range
Dim currentSign As String
Dim currentNumericalCell As Currency
' Find out what sign (+ or -) the current Cell has in it
currentSign = Worksheets("Sheet2").Range("H3").Value
'Variable to associate the numerical number above the current Cell
currentNumericalCell = Worksheets("Sheet2").Range("H2").Value
' Here we iterate through each cell in a specified range
' Since you know you want to start at B1 and go until E1,
' you can ues the following syntax to go through each cell
For Each Cell In Range("B2:H2")
' Get the value of the current cell with the .Value property
currentValue = Cell.Value
' Now get the value of the cell that is before it (column-wise)
previousValue = Cell.Offset(0, -1).Value
' Create a variable for our target cell
Set targetCell = Cell.Offset(1, 0)
' Here are the basic comparisons
If currentValue > previousValue Then
targetCell.Value = "+"
ElseIf currentValue < previousValue Then
targetCell.Value = "-"
ElseIf currentValue = previousValue Then
targetCell.Value = "="
Else
' Not sure how it would happen, but this
' is your catch-all in case the comparisons fail
targetCell.Value = "???"
End If
' Now go to the next cell in the range
Next Cell
'Alex starting to code
For Each Cell In Range("H3:B3")
' Find out what the sign is in the cell before it
previousSign = Cell.Offset(0, -1).Value
'Variable used to find the first cell with an
'Opposite sign as the current cell
oppositeSign = Cell.Offset(0, -2).Value
'Variable to associate the numberical number above the first Opposite Sign Cell
oppositeNumericalCell = Cell.Offset(-1, -2).Value
' Create a Variable for Target Cell
Set targetSignCell = Cell.Offset(1, 0)
If currentSign.Value = "+" And currentSign.Value <> previousSign.Value And oppositeSign.Value = currentSign.Value And currentNumericalCell.Value > oppositeNumericalCell.Value Then
targetSignCell = "U"
ElseIf currentSign.Value = "-" And currentSign.Value <> previousSign.Value And oppositeSign.Value = currentSign.Value And currentNumericalCell.Value < oppositeNumericalCell.Value Then
targetSignCell = "D"
Else
End If
Next Cell
End Sub
I agree with #JohnBustos that a formula would be much more efficient, however if this is indeed a learning exercise then here is a simple example that would do what you want:
Sub Comparison()
Dim targetCell As Range
' Here we iterate through each cell in a specified range
' Since you know you want to start at B1 and go until E1,
' you can ues the following syntax to go through each cell
For Each cell In Range("B1:E1")
' Get the value of the current cell with the .Value property
currentValue = cell.Value
' Now get the value of the cell that is before it (column-wise)
previousValue = cell.Offset(0, -1).Value
' Create a variable for our target cell
Set targetCell = cell.Offset(1, 0)
' Here are the basic comparisons
If currentValue > previousValue Then
targetCell.Value = "+"
ElseIf currentValue < previousValue Then
targetCell.Value = "-"
ElseIf currentValue = previousValue Then
targetCell.Value = "="
Else
' Not sure how it would happen, but this
' is your catch-all in case the comparisons fail
targetCell.Value = "???"
End If
' Now go to the next cell in the range
Next cell
End Sub
And if you were to do it as a formula, it could be something like this (entered into B2 and copied to the end of the range):
=IF(B1>A1,"+",IF(B1<A1,"-","="))
This compares the cell above the formula and the cell to the left of that cell and adds the appropriate symbol.
Assuming there are no empty cells in the range you want to work in, you could do it like this:
Range("b2").Select
Do Until IsEmpty(ActiveCell.Offset(-1, 0))
If ActiveCell.Offset(-1, 0).Value > ActiveCell.Offset(-1, 1).Value Then
ActiveCell.Formula = "+"
End If
If ActiveCell.Offset(-1, 0).Value < ActiveCell.Offset(-1, 1).Value Then
ActiveCell.Formula = "-"
End If
ActiveCell.Offset(0, 1).Select
Loop
If there are empty cells in the range then instead of 'do until' use
dim I
for I = 1 to ..
next I