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
Related
I am trying to write a VBA line where if cell A1 contains a dash anywhere in the cell, then B1 will say "Blue". If there is no dash, then B1 would say "Red".
I have the following code written, but it's not working and I'm not sure if I'm doing the "like" part correctly:
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]=" - ",""Blue"",""Red"")"
Thank you for any help you can provide! I've done so much searching, but have been unable to find any examples that didn't include specific numbers or text.
You can also use
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(FIND(""-"",RC[-1])),""Blue"",""Red"")"
Or a one-liner:
ActiveCell.FormulaR1C1 = "=IF(ISERROR(FIND(""-"",RC[-1])),""Red"",""Blue"")"
You could do it with a simple VBA script like this:
Sub Test()
Dim sh1 As Worksheet
Set sh1 = Sheets("Sheet1")
Application.ScreenUpdating = False
For x = 1 To sh1.Cells(rows.Count, "A").End(xlUp).Row
If InStr(1, sh1.Range("A" & x).Value, UCase("-"), 1) > 0 Then sh1.Range("B" & x).Value= "Red"
If InStr(1, sh1.Range("A" & x).Value, UCase("-"), 1) < 0 Then sh1.Range("B" & x).Value = "Blue"
Next x
Application.ScreenUpdating = True
End Sub
I don't believe that put a formula in every "B" column cells it's a good pratice, Excel can take a long time to calculate.
Try this:
Sub Example()
mySheet.Cells(1, "B").Value = IIf(Not InStr(1, mySheet.Cells(1, "A"), Chr(45), vbTextCompare) = 0, "Blue", "Red")
End Sub
You can loop through every cell you want to put that condition using this code.
Functions:
IIf is equals to Excel Worksheet Function "IF".
InStr search a string in another string, you can pass a unique char as criterea. I used chr(45) because it returns a char according to the passed code, 45 references to Dash code.
The error, corrected (but not pointed out) in several of the other answers lies in changing your formula from
" - "
to
"" - ""
i.e. going from single double-quotes around your - to double double-quotes. The single quote is ending your string - you can even see that the - shows up in black text in your question instead of red text, therefore, it's not part of the string being inserted into ActiveCell.FormulaR1C1.
I am trying to copy some cells in the same sheet if there's a "-" or a "/" in a certain cell.
According to the number of "-" or "/" is the number of times it is going to copy.
This is my code but it's not working, can anyone help?
Sub TWB_Copy_columns()
'TWB_Copy_columns Macro
Dim celltxt As String
Range("B14").Select
Selection.End(xlToRight).Select
celltxt = Selection.Text
If InStr(1, celltxt, "-") Or InStr(1, celltxt, "/") Then
Range("BA5:BB36").Select
Selection.Copy
Range("BD5").Select
ActiveSheet.Paste
Range("BG5").Select
End If
End Sub
It seems that you are looking at the displayed format of a cell's contents to determine if it is a date or not. There is a native VBA function, IsDate that does this determination quite well on true dates. If your data does noot contain dates as true dates, well.. they should be true dates so that is another problem to be fixed.
with worksheets("sheet1")
if isdate(.cells(14, "B").end(xltoright)) then
.range("BA5:BB36").copy destination:=.range("BD5")
end if
end with
It seems to me that this code is only reusable if BA5:BB36 is not static but you've provided no indication on what determines the location. It's probably the last two columns of data in your data block but that is only a guess.
Here's the refactored and fixed version:
Sub TWB_Copy_columns()
'TWB_Copy_columns Macro
'Range("B14").Select
'Selection.End(xlToRight).Select
'celltxt = Selection.Text
' Use explicit references and avoid select. In this case, you will need to
' qualify the workbook and sheetname of the range you are using. We can then
' directly access the value of that range.
' Also, no need to declare a string just to hold onto the value. Directly use the value instead
With ThisWorkbook.Sheets("Sheetname")
If InStr(1, .Range("B14").End(xlToRight).value, "-") > 0 Or InStr(1, .Range("B14").End(xlToRight).value, "/") > 0 Then
.Range("BD5:BB36").value = .Range("BA5:BB36").value
End If
End With
End Sub
First, always avoid Select and Activate. In this case, I directly assign the values instead of trying to copy, paste, or select. Any time you see Range("A5").Select; Selection.Value you really need Range("A5").Value. Likewise, never have an unqualified range. Range("A5") is the same as saying ActiveSheet.Range("A5") which can complicate things if the wrong sheet is active.
Finally, if you are literally using a variable for one comparison, use the direct value. There's no need to create a variable for just one task (at least in my opinion).
Edit:
As Ralph suggests, consider reading this thread: How to avoid using Select in Excel VBA macros. Once you learn to avoid Select your abilities will skyrocket.
This does what I think you're looking for (for every "-" or "/", copy Range("BA5:BB36") and paste it to Range("BD5"), Range("BG5") - leaving a space in your columns):
Sub TWB_Copy_columns()
'TWB_Copy_columns Macro
Dim celltxt As String
Dim vWords As Variant
Dim rFind As Range
Dim i As Long
celltxt = Range("B14").Value
celltxt = Replace(celltxt, "-", "/")
vWords = Split(celltxt, "/")
Range("BA5:BB36").Copy
Range("BD5").Activate
For i = 1 To UBound(vWords)
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 2).Activate
Next
End Sub
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
To begin with I am not at all familiar with vba coding...
I am trying to remove two spaces in a cell with value in it, a text formatted cell for entering big numbers for example 1234 123456 123456...I want the spaces in between the numbers to get removed to give me a number 1234123456123456 without changing the format of the cell and in the same cell where it was initially inserted by copying...
I copy these kinds of number one at a time from a place which provides numbers with spaces and I have to search them in a program which does not except spaces, rather it wont even copy the entire number including spaces.
It must happen automatically as soon as I paste the number in it and click outside the cell or hit enter. Total no. of digits usually is between 16-20... but never less than 16. and always has two spaces. Current after coping the number in the cell I have to delete the two spaces manually and then use it. Once worked on the case is complete then only I can get the next number to work on.
I have used a vba script to generate date in another cell if this column in question has been populated with a value...
the code i have already used is
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Columns("C:C")) Is Nothing Then
Target.Offset(0, -2).Value = Format(Now, "mm/dd/yyyy")
Target.Offset(0, -1).Value = "CL-"
End If
End Sub
I have uploaded the file here link .. so if you want to look into the excel you may...
Please tell me how can I do so and every other details to make it work.. Thanks :)
this one turned out to be allot simpler than i thought it would be :) enjoy and thanks for the opportunity to learn from your questions!
This script will run through all the cells in column A (1) and remove the spaces. the code for changing just one cell to include in the rest of your script would be the section within the for loop.
Sub changeText()
Dim lastRow As Integer
Dim completeString As String
'turn screen updating off (speed things up)
Application.ScreenUpdating = False
'use active sheet from now on
With ActiveSheet
'Find the last used row in column A
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'iterate through each row from first to last (change 1 to account for headings)
For i = 3 To lastRow
'get the complete string from the cell
completeString = Cells(i, 3).Value
'replace all spaces in string with nothing
completeString = Replace(completeString, " ", "")
'enter new value into the same cell it was originally
Cells(i, 3).Value = completeString
'set the cell formatting to number with no decimal places
Cells(i, 3).NumberFormat = "#"
'next iteration
Next i
End With
'allow the screen to update again
Application.ScreenUpdating = True
End Sub
Edit
I changed 3 numbers from my original code. All that was required was to change these lines so that it works with how your spreadsheet was set out.
Change starting value of i to 3 to account for the two rows of headings you have
For i = 3 to lastRow
change these rows so that it performs the operation on column 3 or 'C'
completeString = Cells(i, 3).Value
Cells(i, 3).Value = completeString
Cells(i, 3).NumberFormat = "#"
Edit 2
Ok so what you actually wanted was code that changed the values automatically once they were entered. I modified your worksheet_change sub to achieve this using a similar technique to above. This got me a little bit confused initially as I got trapped in a loop because by changing the cell you then activate the sub to run again... Anyway a little if gate so that it only changes it if spaces are present solved it!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim completeString As String
If Not Application.Intersect(Target, Columns("C:C")) Is Nothing Then
Target.Offset(0, -2).Value = Format(Now, "mm/dd/yyyy")
Target.Offset(0, -1).Value = "CL-"
completeString = Target.Offset(0, 0).Value
If InStr(completeString, " ") > 0 Then
completeString = Replace(completeString, " ", "")
Target.Offset(0, 0).Value = completeString
Target.Offset(0, 0).NumberFormat = "#"
End If
End If
End Sub
Edit 3
It worked with the previous code but when I was trying to edit the no. which was already entered it was making the 16th and later digit turn into 0.... so I made a little change, that is to let the value remain in text format. but serious its just customizing to my need. rest all the hard work is done by D Mason who is the one who created the body of the code.
*Private Sub Worksheet_Change(ByVal Target As Range)
Dim completeString As String
If Not Application.Intersect(Target, Columns("C:C")) Is Nothing
Then
Target.Offset(0, -2).Value = Format(Now, "mm/dd/yyyy")
Target.Offset(0, -1).Value = "CL-"
completeString = Target.Offset(0, 0).Value
If InStr(completeString, " ") > 0 Then
completeString = Replace(completeString, " ", "")
Target.Offset(0, 0).Value = CStr(completeString)
'let the value remain in text format instead of number.
End If
End If
End Sub*
Without any VBA, you can select the range of cells and do a Find replace " " with nothing. Ctrl F - > Add a space in the "Find" cell and do nothing in the Replace box and say
"Replace All". All the spaces will be replaced with nothing i.e. removed.
Maybe you could try using Regex?
Please make sure you first go to the Tools>References menu in the VBA IDE (Alt F11) and select Microsoft VBScript Regular Expressions 5.5, which will allow the use of RegExp objects in your code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rgx As RegExp
Set rgx = New RegExp
With rgx
.Pattern = " " 'searching for spaces
.Global = True 'all matches (not only the first match)
Target.Cells(1, 1).Value = .Replace(Target.Cells(1, 1).Value, "") 'replace matches by ""
End With
End Sub
This will replace all spaces, not only two of them, nor will it check that your input only consists of numbers and two spaces. You could use regex functions to improve this though.
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.