If statement with a loop - large data set - excel

Currently I am using the following code to add a formula to cells in the column for a predefined range of cells. The problem is that the number of cells I need the formula in fluctuates based on how big the data set is.
Range("R9").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<0,""False"",""True"")"
Selection.AutoFill Destination:=Range("R9:R12000")
Range("R9:R62053").Select
What I want to do is for every cell that has a value in say column B, I want the macro to insert the formula in the corresponding cell in column C, and stop once it reaches a point where the cell in column b has no value.

The code below is based off the OP's comments. Where as, his code seems to be targeting R9:R12000"
Dim cell As Range, Target As Range
With Worksheets("Sheet1")
Set Target = .Range("B9", .Range("B" & .Rows.Count).End(xlUp))
For Each cell In Target
If cell.Value <> "" Then cell.Offset(0, -1).Formula = "=IF(RC[-1]<0,""False"",""True"")"
Next
End With

Related

Selecting first and next cell in filtered criteria range

I want to select next cell in Filtered range using VBA
For example,
Column A having set of values and column B having set of values,
I have to filter column B and criteria is Sunday for eg.,
for Sunday I want to re-write as Noted down.
I tried this code also
With ActiveSheet.AutoFilter.Range
Range("B" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
End with
I am getting error of Application defined or object defined error.
We cant even simply move to next cell in filtered range?
Any easy way is there to move to first and next cell in filtered criteria?
enter image description here
enter image description here
Try this... It will update each cell for filtered data in c column...
Sub code()
Range("A1").Select
Selection.AutoFilter
Set Rng = ActiveSheet.Range("$A$2:$C$10")
Rng.Columns(3).ClearContents
Rng.AutoFilter Field:=2, Criteria1:="Sunday"
For Each cell In Rng.Columns(3).Cells.SpecialCells(xlCellTypeVisible)
cell.Value = "Noted Down"
Next cell
Selection.AutoFilter
End Sub

Increase row by 1

I want the VBA code to use the value from B1 and present the result in A1, then the VBA code uses the value from B2 and presents the result in A2.
It works for B1 as I get the value in A1. I visible see the cursor on the excel sheet move down the B column, but nothing changes in the A column for results, not even the A1 cell is being overwritten.
It seems that the changing of rows works. However, the code isn't updating to utilize other cells in column A to post results.
This code is pulling an email address from B1, using the LDAP VBA function to make an inquiry of an active directory, and then returning the DisplayName of the member of the email into cell A1.
Range("B1").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
ActiveSheet.Range("A1").Value = gigIDldap(4, True, Range("B1")) <--A1 will have the value from the gigID1dap VBA function using the value listed in B1
' Insert your code here.
' Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
Loop
' ******This didn't work. It gave a type mismatch error
For Each Row In ActiveSheet.Rows
ActiveSheet.Range("A1").Value = Row.Value
For Each cell In Values
ValueCell = Range("B1")
Next cell
Next Row
End Sub
Something like this?
Dim r As Long 'row pointer
With ActiveSheet
For r = 1 To .Cells(.Rows.Count, "B").End(xlUp).Row 'loop from row 1 to last used cell in column B
.Cells(r, 1).Value = gigIDldap(4, True, .Cells(r, 2).Value) 'write to column 1 with result from column 2
Next
End With

Is there a way to reference if cells have decimal point in vba?

I want to have create some code in VBA that will look through the cells in a worksheet in column B. If the code finds a cell value with a decimal (opposed to a whole number e.g. not 1, but 1.1) then print the cell value to right off it in another sheet.
I know it will be a loop and it will use offset hit etc. I havent tried this code in VBA i have just typed it as an example of what i will do in the question.
For each cell in Sheets("Sub Tasks").Range("B1:B" & LastRow)
If cell = '(DECIMAL FORUMLA) Then
You may use something like this:
Dim cell As Range
For Each cell In Sheets("Sub Tasks").Range("B1:B" & LastRow)
If IsNumeric(cell.Value) Then
If Val(cell.Value) <> Int(cell.Value) Then
' The number contains decimals.
Dim valueToTheRight As Variant
valueToTheRight = cell.Offset(0, 1).Value
' TODO: Add `valueToTheRight` into the appropriate place of the other sheet.
End If
Else
' The cell value is not a number.
' TODO: either do something about it or remove the `else` branch to ignore it.
End If
Next
You could evaluate the cells content?
Sub Demo()
Dim cell
For each cell in Sheets("Sub Tasks").Range("B1:B" & LastRow)
If IsNumeric(c.Value2) And InStr(c.Value2, Application.DecimalSeparator) Then
Debug.Print c.Value2
End If
Next c
End Sub
IsNumeric will test if the cell holds a number. i.e. skipping any strings with full stops in. and Instr(c.value2, Application.DecimalSeparator) will test for the decimal

Incrementing SUM function to include newly inserted row in VBA

I am trying to find a way to update the subtotal at the bottom of the table so it includes newly inserted row values.
For example, in the following spreadsheet, I have a button that inserts rows at the end of a table (to add new items). This button utilizes vba. I just inserted row 4 using vba, and it is blank. However, in the subtotal line, the sum function did not change to include the new row. What can I add to the end of my VBA code to modify that sum formula to include the new row (and extend the range down by one cell)? So that whenever I use my button to add a row, it also extended the range by one cell down? (to include b4)
Example Spreadsheet
This code puts a formula in B20 based on the number of cells filled above it:
Sub Formulamaker()
Dim rng As Range
Set rng = Range(Cells(1, "B"), Cells(1, "B").End(xlDown))
Range("B20").Formula = "=SUM(" & rng.Address & ")"
End Sub
In your example the formula is inserted two cells below the data. If you always want the formula to be placed two cells below the data then:
Sub Formulamaker()
Dim rng As Range
Set rng = Range(Cells(1, "B"), Cells(1, "B").End(xlDown))
Cells(rng.Rows.Count + rng.Row + 1, "B").Formula = "=SUM(" & rng.Address & ")"
End Sub

How to copy specific cells from one sheet to another meting if criteria

I'm brand new to VBA.
I want to copy specific cells from one sheet to another based on a criteria.
For instance if in the range of H2:H1000 value = "Yes" then copy cells from column A,B,C and D from same row where the criteria meets to another sheet.
My code is just a scratch from what I managed to do, I don't know how to select the cells from the same row where the criteria meets.
Sub FindandCopy()
Dim rngA As Range
Dim cell As Range
Set rngA = Sheets("OFCE").Range("H2:H1000")
For Each cell In rngA
If cell.Value = "Yes" Then
cell.EntireRow.Copy
Sheets("Dashboard").Range("I2").End(xlDown).Select
ActiveSheet.Paste
End If
Next cell
End Sub
You might want to try using v-lookup or a simple sumif function. You can do this outside of vba, in the sheet itself, or you can program it into your existing macro.
Plenty of material online on this so you should be able to solve it.
I used offset (to get from H to A) and resize (to expand A to A-D) and then copy to the first unused row of I on the other sheet.
You don't need to Select/Activate, in fact it's discouraged.
Sub FindandCopy()
Dim rngA As Range
Dim cell As Range
Set rngA = Sheets("OFCE").Range("H2:H1000")
For Each cell In rngA
If cell.Value = "Yes" Then
cell.Offset(, -7).Resize(, 4).Value.Copy _
Sheets("Dashboard").Range("I" & Rows.Count).End(xlUp)(2)
End If
Next cell
End Sub
However, rather than a loop, you should consider using AutoFilter or Find to do this as they are more efficient.

Resources