I have a question regarding some code which doesn't seem to be working properly for me.
I have set up some code for what I believe is a basic loop through range and replace adjacent row cell, and although no errors are occurring I am not getting the desired result.
If anyone knows better could they look through the code below and give me some advice / a fix to get things rolling:
For Each cCell In Range("C16,C1000")
'perform action if cell value = "-"
If ActiveCell.Value = "-" Then
'move to adjacent cell
ActiveCell.Offset(0, 1).Select
'change the cell value to "-"
Selection.cell.Value = "-"
Else
ActiveCell.Offset(0, 1).Select
End If
Next cCell
Rather than using ActiveCell.Value you should just use cCell.Value
Also, avoid using Select. It's evil.
For example:
cCell.Offset(0,1).Value = "-"
yes avoid using select. But if you have to, you need to do this. You have to select cCell in each iteration so that ActiveCell picks it up.
You don't need to use Select though and shouldn't, you can still update cCell without selecting it first. As stated by joseph4tw.
For Each cCell In Range("C16,C1000")
'perform action if cell value = "-"
cCell.select
If ActiveCell.Value = "-" Then
'edit adjacent cell
ActiveCell.Offset(0, 1).Value = "-"
End If
Next cCell
Related
Generally my macro goes through every "O" cell, checks if the row meets given requirements (not mentioned in this part of code) and copies surrounding cells on the side. I have two columns used in this part: "contract no"(M), "date"(O). The problem is that I try to use below method to go up to last the contract number and copy it as well.
I do not get any error but the contract cell value does not paste. Could you tell me what I've done wrong?
If ActiveCell.Offset(0, -2) = "" Then
'Go up find contract number copy
ActiveCell.Offset(0, -2).Select
Do Until ActiveCell.Value <> ""
ActiveCell.Offset(-1, 0).Select
Loop
ActiveSheet.Range("M" & ActiveCell.Row).Copy _
Destination:=ActiveSheet.Range("V" & ActiveCell.Row)
'Go down and return to the last active cell
Do Until ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 2).Select
End If
You didn't select the desired cell
Problem lies in this loop:
'Selecting cell from a column to the left
ActiveCell.Offset(0, -2).Select
'Condition: cell value is not empty string
Do Until ActiveCell.Value <> ""
'Selecting cell from previous row in the same column
ActiveCell.Offset(-1, 0).Select
Loop
You're leaving the loop before you can .Select a cell.
Use this loop instead:
'Selecting cell from a column to the left
ActiveCell.Offset(0, -2).Select
'Condition: cell value is not empty string
Do
'Selecting cell from previous row in the same column
ActiveCell.Offset(-1, 0).Select
Loop Until ActiveCell.Value <> ""
the issue lays in your keeping relying on ActiveCell after
ActiveCell.Offset(-1, 0).Select
statement, that changes it ...
you're actually playing with fire when using ActiveCell together with Select/Selection coding pattern!
since I cannot see what's behind the code you showed, I must keep using ActiveCell reference and amend your code as per comments:
Dim cellToCopy As Range
With ActiveCell 'reference currently "active" cell
If .Offset(0, -2) = "" Then 'if the cell two columns left of referenced (i.e. "active") cell is empty...
Set cellToCopy = .Offset(0, -2).End(xlUp) '... set cell to copy as the first not empty one above the cell two columns left of referenced (i.e. "active") cell
Else '... otherwise
Set cellToCopy = .Offset(0, -2) 'set cell to copy as the one two columns left of referenced (i.e. "active") cell
End If
cellToCopy.Copy Destination:=Range("V" & .Row) 'copy the cell set as the one to be copied and paste it column V cell same row as reference (i.e. "active") cell
End With
Try not to use ActiveCell Your code can do quite unpredictable things to your worksheet if the wrong cell was selected, and so can my "improvement" thereof below.
Sub FindAndCopy()
Dim Ws As Worksheet
Dim R As Long, C As Long
With ActiveCell
Set Ws = .Worksheet
R = .Row
C = .Column
End With
With Ws
If Len(Trim(.Cells(R, C - 2).Value)) = 0 Then
'Go up find contract number copy
Do Until Len(.Cells(R, C - 2).Value)
R = R - 1
Loop
.Cells(R, "M").Copy Destination:=.Cells(ActiveCell.Row, "V")
End If
End With
End Sub
I think the ActiveCell component in this code is still a source of great danger. However, as you see, at least the code doesn't change it which dispenses with the necessity of going back to it in the end.
I have some VBA code written that runs quite slowly. I have a series of different loops in my code. I know that loops aren't always the most efficient way to manipulate data, so I think they are the problem. I need ideas for how to either alter the loop or eliminate it so I can speed up the run time of my code.
Below is the most active loop I have created. It's running through all of the cells on row D (starting in D2) and manipulating their values based off of entries in the cells in row 1. If I can get help on this loop I'll probably be able to use similar techniques to alter the other loops in my code. Any tips are appreciated.
'sub work week for date range
Range("D2").Select
Do Until IsEmpty(ActiveCell.Value)
If IsEmpty(ActiveCell.Offset(-1, 0)) = False Then
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value & "-" & Right(ActiveCell.Value, 4)
Else: ActiveCell.Value = ActiveCell.Value & "-" & Right(ActiveCell.Offset(0, -1), 4)
End If
ActiveCell.Offset(0, 1).Select
Loop
The fastest, and more efficient method, would be as has been suggested in the comments by using arrays.
To get you to that point though, I've given you the first steps to improving your interaction with VBA and understanding how to write your code without selecting or activating objects:
For i = 4 To Cells(2, Columns.Count).End(xlToLeft).Column
With Cells(2, i)
If .Offset(-1, 0).Value = vbNullString Then
.Value = .Value & "-" & Right$(.Offset(0, -1).Value, 4)
Else
.Value = .Offset(-1, 0).Value & "-" & Right$(.Value, 4)
End If
End With
Next
Basically, you don't need to .Select or .Activate anything. Work with the objects directly and use a variable to dictate the column rather than activating the next cell.
Once you're comfortable with writing code in this style, look at assigning a range's value to a 2D array and then loop through the array instead.
For fast execution, my first recommendation is to turn automatic calculation and screen-updating off too if it still takes long.
I agree that anything that involves selecting is going to be incredibly slow so you should use range objects instead.
Final code:
' Declarations
Dim CurrentCell, LeftCell, PreviousCell As Range
Dim Last4Chars As String
'Initialize
Set CurrentCell = ActiveSheet.Range("D2")
'Optimizations
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'Loop until Current Cell in Empty
Do Until IsEmpty(CurrentCell.Value)
Set AboveCell = CurrentCell.Offset(-1, 0) 'One row above
Set LeftCell = CurrentCell.Offset(0, -1) 'One column left
If IsEmpty(AboveCell) = False Then
CurrentCell.Value = AboveCell.Value & "-" & Right(CurrentCell.Value, 4)
Else
CurrentCell.Value = CurrentCell.Value & "-" & Right(LeftCell, 4)
End If
Set CurrentCell = CurrentCell.Offset(0, 1)
Loop
'Optimizations reversed for normal use
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
This question already has answers here:
How do I put double quotes in a string in vba?
(5 answers)
Closed 1 year ago.
I am attempting to write some VBA which will add header text to 3 cells then fill a formula all the way down to the last row. I have written the below, which writes the headers no problems, but when it get's to my first .Formula it throws a
Application Defined or Object Defined error
What needs to be altered so that this macro will execute successfully? (The formulas were pulled directly from the formula in the cell, so I know they are valid formulas at least on the "front-end")
Function Gre()
Range("E2").Select
ActiveCell.FormulaR1C1 = "Under"
Range("F2").Select
ActiveCell.FormulaR1C1 = "Over"
Range("G2").Select
ActiveCell.FormulaR1C1 = "Result"
With Range("E2:E" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=IF(C2<B2,B2-C2,"")"
End With
With Range("F2:F" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=IF(C2>B2,C2-B2,0)"
End With
With Range("G2:G" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=IF(F2>0,'Issue',"")"
End With
End Function
The problem is likely that you are escaping the quotes with the formula.
What you need is:
.Formula = "=IF(C2>B2,B2-C2,"""")"
for the first one, for example. The other quotes need to be doubled as well.
As a side-note, it would also be best to specify the sheet you are working on with something like:
Dim ws as worksheet
Set ws = Sheets("mySheet")
ws.Range("E2").FormulaR1C1 = "Under"
etc.
If you don't do this, you can sometimes have errors happen while running the code.
As suggested by OpiesDad, to minimize ambiguity, avoid ActiveCell and the like.
Using Select will also slow down performance a lot compared to assigning to cells directly.
I'm pretty sure you need to escape quotes in Excel formulas inside of VBA by doubling the quotes, so a normal empty string becomes """". You also have Issue in single quotes in a formula, which I'm pretty sure will error in Excel; that should be in escaped double quotes as well.
I'm having a hard time figuring out what Range("E2:E" & Cells(Rows.Count, "C").End(xlUp).Row) actually does, but it sounds like you want to select E2 to the last used row of the sheet. Avoid Rows.Count or just generally referring to the rows of a sheet, as that will go to row 10^31. Use Worksheet.UsedRange to get the range from the first row and column with content to the last row and column with content. This also includes empty strings and can be a bit tricky sometimes, but is usually better than dealing with thousands of extra rows.
Also,
You don't need to use With if your only enclosing one statement, although it won't cause any problems.
I would not mix use of Range.Formula and Range.FormulaR1C1 unless you have a reason to.
Function Gre()
Dim ws as Worksheet
Set ws = ActiveSheet
Dim used as Range
Set used = ws.UsedRange
Dim lastRow as Integer
lastRow = used.Row + used.Rows.Count - 1
ws.Range("E2").Formula = "Under"
ws.Range("F2").Formula = "Over"
ws.Range("G2").Formula = "Result"
ws.Range("E2:E" & lastRow).Formula = "IF(C2<B2, C2-B2, """")"
ws.Range("F2:F" & lastRow).Formula = "IF(C2<B2, C2-B2, 0)"
ws.Range("G2:G" & lastRow).Formula = "IF(F2>0, ""Issue"", """")"
End Function
The first issue is the selecting of cells. This requires the macro to select the cell, then determine the cell address. If you need to actually select a cell, use Application.ScreenUpdating = False. Then the macro doesn't have to show the cursor selection of a cell. Dropping the select and incorporating the range into the formula assignment code line like below will gain some speed/efficiency.
Range("E2").FormulaR1C1 = "Under"
Range("E2:E" & Cells(Rows.Count, "C").End(xlUp).Row) is the code version of selecting the last cell in a blank column (row 1048576), then using the keystroke of ctrl and the up key to determine the lowest/last used cell. This gets you a row count of 1 every time since the column is blank. Since you're looking for the last row. It may be faster to count down from the top. My favorite method for this is a loop. Increment a variable within a loop, while looking for the last row. Then, the variable can be used instead of your bottom up strategy.
t = 0
Do Until Range("C2").Offset(t, 0).Value = ""
t = t + 1
Loop
With Range("E2:E" & t)
.Formula = "=IF(C2<B2,B2-C2,"""")"
End With`
Just like TSQL, quote characters need their own quote characters.
.Formula = "=IF(C2<B2,B2-C2,"""")"
The Range Fillup VBA function can be utilized in this case to fill all cells from the bottom with a common formula, accounting for Excel Formula Reference Relativity. The code below starts with the range that we got from the loop counter. Next, we set a variable equal to the total rows in Excel minus the row corresponding to the counter row. Then, we resize the original region by the necessary rows and use the FillDown function to copy the first formula down.
Here's the resulting code. This will fill the range starting from the last row in Excel.
Sub Gre()
Range("E2").FormulaR1C1 = "Under"
Range("F2").FormulaR1C1 = "Over"
Range("G2").FormulaR1C1 = "Result"
Do While Range("e2").Offset(t, 0).Value <> ""
t = t + 1
Loop
Range("E2").Offset(t, 0).Formula = "=IF(C2<B2,B2-C2,"""")"
r1 = Range("e2").EntireColumn.Rows.Count
r2 = Range("E2").Offset(t, 0).Row
Range("E2").Offset(t, 0).Resize(r1 - r2, 1).FillDown
Range("F2").Offset(t, 0).Formula = "=IF(C2>B2,C2-B2,0)"
Range("F2").Offset(t, 0).Resize(r1 - r2, 1).FillDown
Range("G2").Offset(t, 0).Formula = "=IF(F2>0,""Issue"","""")"
Range("G2").Offset(t, 0).Resize(r1 - r2, 1).FillDown
End Sub
As well as using double quotes you may need to use 0 in the first two formula otherwise they may evaluate to empty strings. This may give unexpected results for the last formula i.e. incorrectly return "Issue".
If you do not have blank columns between your data and the 3 new columns you can use CurrentRegion to determine the number of rows:
Range("E2:E" & Cells.CurrentRegion.Rows.Count).Formula = "=if(C2'<'B2,B2-C2,0)"
Range("F2:F" & Cells.CurrentRegion.Rows.Count).Formula = "=if(C2>B2,C2-B2,0)"
Range("G2:G" & Cells.CurrentRegion.Rows.Count).Formula = if(F2>0,""Issue"","""")"
Please try the following sample hope it will help you to wright formula in VBA
Sub NewEntry()
Dim last_row As Integer
Dim sht1 As Worksheet
Dim StockName As String
Set sht1 = Worksheets("FNO MW")
last_row = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'MsgBox last_row
StockName = sht1.Cells(last_row, 1).Value
sht1.Cells(last_row, 1).Formula = "=RTD(""pi.rtdserver"", ,"" " & StockName & " "", ""TradingSymbol"")"
End Sub
I have written a very simple code which returns the last 6 characters of every active cell within a range.
The code works pretty good until it finds a particular cell in which the characters to be returned should be: "MARC01". Unfortunately it returns a date type character (01.Mrz).
By using the normal excel formula it works fine, that is why I would expect it to work with a Macro as well.
Here you can see my code which takes the strings from column "A" and enters it in column "B":
Range("B12").Activate
Do
ActiveCell.Value = Right((ActiveCell.Offset(0, -1).Value), 6)
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Offset(0, -1).Value = 0
Excel likes to change anything that looks like a possible date to a date. To force this not to happen put a "'" in front of the formula.
ActiveCell.Value = "'" & Right((ActiveCell.Offset(0, -1).value), 6)
This will force it to stay text. The down side to this is, if it is a number it will be saved as text.
Excel likes to try to interpret certain data, rather than just leaving it as is. It especially does that with strings that look like dates, and with numeric entries.
Two ways to workaround are
Put the text prefix character in front of your string. This is usually a single quote. (see Scott's answer for code)
Format the cell as Text before you place the value there.
Sub foo()
Range("B12").Activate
Do
ActiveCell.NumberFormat = "#"
ActiveCell.Value = Right((ActiveCell.Offset(0, -1).Formula), 6)
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Offset(0, -1).Value = 0
End Sub
With this simple goal, I don't know why you need VBA looping.
You can just mass set the formular1c1 to =RIGHT(RC[-1],6).
Option Explicit
Sub Right6()
Const R6LeftCol = "=RIGHT(RC[-1],6)"
Dim oRng As Range, lRow As Long
lRow = Cells(Rows.Count, "A").End(xlUp).Row
Set oRng = Range("B12")
Range(oRng, Cells(lRow, "B")).FormulaR1C1 = R6LeftCol
Set oRng = Nothing
End Sub
I've run accross this problem many times and still haven't found the solution or why this won't work. I want to use cells method to enter a formula through a column and so I write this:(just an example)
With ws
iEndCol = .cells(4650,1).End(Xlup).Column
For i = 2 To iEndCol
.Cells(i, 2) = "=VLOOKUP([RC-1],Somesheet!someTable,10,FALSE)"
Next
End With
when this dosen't work (Method error) I try something like this:
Cells(i,2).Select
Do While IsEmpty(ActiveCell.Offset(0, -1)) = False
ActiveCell.Formula = "=VLOOKUP([RC-1],Somesheet!someTable,10,FALSE))"
ActiveCell.Offset(1, 0).Select
Loop
or instead of .Formula, I try .FormulaR1C1, .Formulalocal etc. and this doesn't work either. Then this is what works:
Range("B2").Select
Do Until IsEmpty(ActiveCell.Offset(0, 5)) And IsEmpty(ActiveCell.Offset(0, 6))
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(0, 1).Formula = "=VLOOKUP(B2,Somesheet!someTable,10,FALSE)"
End If
ActiveCell.Offset(1, 0).Select
Loop
What am I not understanding on using Cells to enter formulas?
Enter a formula using Excel interface (not your code).
Now go to the code editor, press Ctrl+G and type: ? activecell.FormulaR1C1
The result, =VLOOKUP(RC[-1],Somesheet!sometable,10,FALSE), will tell you what you are doing wrong. You are not providing correct RC syntax.
Having that said, you should always ensure your formula syntax matches the property you have picked to set that formula. Use A1 notation for .Formula, and RC notation for FormulaR1C1. And don't use .Value to set a formula.
First, the following worked for me:
Set oCell = ActiveCell
Do
Set oCell = oCell.Offset(0, 1)
oCell.FormulaR1C1 = "=VLOOKUP(RC[-1],SomeTable,10,FALSE)"
Set oCell = oCell.Offset(1, -1)
Loop Until IsEmpty(oCell)
Notice that in my syntax, I assumed that SomeTable was a defined name with Workbook scope and thus I need no prefix. If SomeTable is a defined name scoped to a specific Worksheet, only then do you need to prefix the sheet name (e.g. Somesheet!SomeTable).
Second, you should verify in which cell it is trying to put the formula using Debug.Print oCell.Address. It may be the case that it is trying to stuff the formula in literally the first column which would cause an error in the formula.