I want to look in a range and find flag certain values, then populate the same row in another column based on those values.
Column 1 Column 2
Code1
Code10
If I specify Code1 in the macro, I want to populate column 2.
I have the following code. I get a runtime error. How can I avoid a runtime error.
Sub Test()
With Sheets("Sheet1")
Set r = .Range("A:A").Find(what:="Old", LookIn:=xlValues)
Dim rownum As Long
rownum = r.Row
Dim rownum2 As Long
rownum2 = rownum - 1
With Sheets("Sheet1")
Set r2 = .Range("C6:C" & rownum2)
Dim cell As Variant
For Each cell In r2
If Cells.Value = ("Code1" Or "Code2" Or "Code3" Or "Code4") Then
.Select
.Offset(0, 7).Value = "Special"
End If
Next cell
End With
End With
End Sub
I cleaned it up a little:
Sub Test()
Dim r2 As Range
Dim rownum2 As Long
Dim cell As Range
With Sheets("Sheet1")
rownum2 = .Range("A:A").Find(what:="Old", LookIn:=xlValues).Row - 1
Set r2 = .Range("C6:C" & rownum2)
End With
For Each cell In r2
If cell.Value = "Code1" Or cell.Value = "Code2" Or cell.Value = "Code3" Or cell.Value = "Code4" Then
cell.Offset(0, 7).Value = "Special"
End If
Next cell
End Sub
The main issue was the If statement. See above for the proper method of using the Or statement.
Related
I have written a macro to remove rows containing certain text in it. If either of the keyword contains any text, the macro will delete the row. However, the macro doesn't work at all. Perhaps, i did something wrong in it. Hope somebody will help me rectify this. Thanks in advance.
Here is what I'm trying with:
Sub customized_row_removal()
Dim i As Long
i = 2
Do Until Cells(i, 1).Value = ""
If Cells(i, 1).Value = "mth" Or "rtd" Or "npt" Then
Cells(i, 1).Select
Selection.EntireRow.Delete
End If
i = i + 1
Loop
End Sub
The keyword within the text I was searching in to delete:
AIRLINE DRIVE OWNER mth
A rtd REPAIRS INC
AANA MICHAEL B ET AL
ABASS OLADOKUN
ABBOTT npt P
AIRLINE AANA MTH
ABASS REPAIRS NPT
Try like this.
What about Using Lcase.
Sub customized_row_removal()
Dim rngDB As Range, rngU As Range, rng As Range
Dim Ws As Worksheet
Set Ws = Sheets(1)
With Ws
Set rngDB = .Range("a2", .Range("a" & Rows.Count))
End With
For Each rng In rngDB
If InStr(LCase(rng), "mth") Or InStr(LCase(rng), "rtd") Or InStr(LCase(rng), "npt") Then
If rngU Is Nothing Then
Set rngU = rng
Else
Set rngU = Union(rngU, rng)
End If
End If
Next rng
If rngU Is Nothing Then
Else
rngU.EntireRow.Delete
End If
End Sub
VBA syntax of your Or is wrong,
If Cells(i, 1).Value = "mth" Or "rtd" Or "npt" Then
Should be:
If Cells(i, 1).Value = "mth" Or Cells(i, 1).Value = "rtd" Or Cells(i, 1).Value = "npt" Then
However, you need to use a string function, like Instr or Like to see if a certain string is found within a longer string.
Code
Option Explicit
Sub customized_row_removal()
Dim WordsArr As Variant
Dim WordsEl As Variant
Dim i As Long, LastRow As Long
Dim Sht As Worksheet
WordsArr = Array("mth", "rtd", "npt")
Set Sht = Worksheets("Sheet1")
With Sht
' get last row in column "A"
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = LastRow To 2 Step -1
For Each WordsEl In WordsArr
If LCase(.Cells(i, 1).Value) Like "*" & WordsEl & "*" Then
.Rows(i).Delete
End If
Next WordsEl
Next i
End With
End Sub
I try to make my code sample as I can if you have any question please ask
Private Sub remove_word_raw()
'PURPOSE: Clear out all cells that contain a specific word/phrase
Dim Rng As Range
Dim cell As Range
Dim ContainWord As String
'What range do you want to search?
Set Rng = Range("A2:A25")
'sub for the word
shorttext1 = "mth"
shorttext2 = "rtd"
shorttext3 = "npt"
'What phrase do you want to test for?
ContainWord1 = shorttext1
ContainWord2 = shorttext2
ContainWord3 = shorttext3
'Loop through each cell in range and test cell contents
For Each cell In Rng.Cells
If cell.Value2 = ContainWord1 Then cell.EntireRow.Delete
Next
For Each cell In Rng.Cells
If cell.Value2 = ContainWord2 Then cell.EntireRow.Delete
Next
For Each cell In Rng.Cells
If cell.Value2 = ContainWord3 Then cell.EntireRow.Delete
Next cell
End Sub
I need to create output like the following:
Column A | Column B
1. 1 1
2. 1
3. 2 2
4. 2
5. 2
So far, I have written the following code:
Sub ItemNum()
Dim rng As Range
Dim i As Long
Dim cell
Set rng = Range("A1:A99")
i = 1
For Each cell In rng
If (...) Then
cell.Offset(0, 1).Value = i
End If
Next
End Sub
I have already obtained the number sequence in column A. I need to add the same value in column B down to the column.
I would like to know how to add to increment statement.
Thanks
If what you are wanting to do is place a value from column A into every cell in column B until you come to another value in Column A, then the following should work:
Sub ItemNum()
Dim rng As Range
Dim i As Variant
Dim cell
Set rng = Range("A1:A99")
i = "Unknown"
For Each cell In rng
If Not IsEmpty(cell) Then
i = cell.value
End If
cell.Offset(0, 1).Value = i
Next
End Sub
You can do this without loops (quicker code):
Sub FastUpdate()
Dim rng1 As Range
Set rng1 = Range([a2], Cells(Rows.Count, "a").End(xlUp))
'add two rows
Set rng1 = rng1.Resize(rng1.Rows.Count + 2, 1)
'add first row
[b1].Value = [a1].Value
With rng1
.Offset(0, 1).FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1],R[-1]C)"
.Offset(0, 1).Value = .Offset(0, 1).Value
End With
End Sub
If you use a For...Next loop instead of For...Each loop then you can use the counter variable to address the cells in column B:
Option Explicit
Sub ItemNum()
Dim rng As Range
Dim lngCounter As Long
Dim strCellValue As String
Set rng = Range("A1:A99")
strCellValue = 0
For lngCounter = 1 To rng.Cells.Count
If rng(lngCounter, 1).Value <> "" Then
strCellValue = rng(lngCounter, 1).Value
End If
rng(lngCounter, 2).Value = strCellValue
Next
End Sub
E.g.
If i understand correctly, below is the answer for you.
Assuming your data starts with A2 then Apply the below formula in B2 and drag down up to the last
=IF(A2<>"",A2,B1)
Note: A column data may be Number or anything.
Proof
Below is a Sub that is being used to format all cells as text in the spreadsheet starting with worksheet3 onwards. As you'll see there's a line in bold that I will most likely need to change. One of the purposes of the line is to keep the values of the Column1 ("Client ID") intact because in every sheet it consists '00001' values that converted with this code would change to '1'. That's wrong. Important thing is that Column1 in every worksheet always contains the same '00001' values.
Sub formatAllCellsAsText()
Dim wsTemp As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Dim Cell As Range
For sht = 3 To Worksheets.Count
Set wsTemp = Sheets(sht)
Set StartCell = wsTemp.Range("A4")
LastRow = wsTemp.Range("A4").CurrentRegion.Rows.Count
LastColumn = wsTemp.Range("A4").CurrentRegion.Columns.Count
For Each Cell In wsTemp.Range(StartCell, wsTemp.Cells(LastRow, LastColumn)).Cells
If Not IsEmpty(Cell.Value) And IsNumeric(Cell.Value)
And InStr(wsTemp.Cells(1, Cell.Column), "Client ID") <= 0 Then
Dim Temp As Double
Temp = Cell.Value
Cell.ClearContents
Cell.NumberFormat = "#"
Cell.Value = CStr(Temp)
End If
Next
Next sht
End Sub
Now my problem is that in one worksheet there's Column6 ("Value") that I want to preseve 000s in front of a number. When I change the line to the following my macro still removes preceding 000s from the Column6 values. I guess the condition is not as straightforward as I have thought.
If Not IsEmpty(Cell.Value) And IsNumeric(Cell.Value) And
InStr(wsTemp.Cells(1, Cell.Column), "Client ID") <= 0 And
InStr(wsTemp.Cells(6, Cell.Column), "Value") <= 0 Then
Any suggestions?
Pls try this:
Sub formatAllCellsAsText()
Dim wsTemp As Worksheet
Dim LastRow As Long, LastColumn As Long
Dim StartCell As Range, Cell As Range
Dim Temp As Double
Dim Temp2 As String
For sht = 3 To Worksheets.Count
Set wsTemp = Sheets(sht)
Set StartCell = wsTemp.Range("A4")
LastRow = wsTemp.Range("A4").CurrentRegion.Rows.Count
LastColumn = wsTemp.Range("A4").CurrentRegion.Columns.Count
For Each Cell In wsTemp.Range(StartCell, wsTemp.Cells(LastRow, LastColumn)).Cells
If Not IsEmpty(Cell.Value) And IsNumeric(Cell.Value) And InStr(wsTemp.Cells(1, Cell.Column), "Client ID") <= 0 Then
Temp = Cell.Value
Temp2 = Cell.NumberFormat
Cell.ClearContents
Cell.NumberFormat = "#"
Cell.Value = Format(Temp, Temp2)
End If
Next
Next
End Sub
You simply check for the number format and then apply it to the string. This way "0001" stays "0001". Another way would be the use of .Text
Dim Temp As String
Temp = Cell.Text
Cell.ClearContents
Cell.NumberFormat = "#"
Cell.Value = Temp
You also can do this only if If IsNumeric(Cell.Value) And Left(Cell.Text, 1) = "0" Then is true, so that rule only applies to cells with numerical values having leading zeros ;)
Column1 in every worksheet always contains the same '00001' values.
Change the line
Cell.Value = CStr(Temp)
to
Cell.Value = Format(Temp,"00000")
I'm trying to add a unit of 1 to many cells in a range. Below is where I'm at and I keep getting a type mismatch error:
Dim r As Range, cell As Range
Set r = Range("D2:E1000")
For Each cell In r
If cell.Value > 0 Then
cell.Value = cell.Value + 1
End If
Next
Here's another way
Sub Sandwich()
Dim rTemp As Range
Dim rTarget As Range
Dim sNumFmt As String
'Define the ranges
Set rTemp = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0)
Set rTarget = Sheet2.Range("D2:E1000")
'store a temporary value and the current number format
rTemp.Value = 1
sNumFmt = rTarget.Cells(1).NumberFormat
'copy and paste special-add
rTemp.Copy
rTarget.PasteSpecial , xlPasteSpecialOperationAdd
'get rid of the temp and reapply the format
rTemp.ClearContents
rTarget.NumberFormat = sNumFmt
End Sub
How about:
Sub marine()
Dim r As Range, cell As Range
Set r = Range("D2:E1000")
For Each cell In r
If IsNumeric(cell.Value) Then
If cell.Value > 0 Then
cell.Value = cell.Value + 1
End If
Else
MsgBox "Cell " & cell.Address(0, 0) & " does not have a number"
Exit Sub
End If
Next
End Sub
Stopping at OK, I'm trying to add a unit of "1" to many cells in a range. the easiest way is often without VBA or code. Just insert 1 somewhere on the spreadsheet, copy that cell, select the range of interest and Paste Special with Operation Add. The 1 can then be deleted.
Dim r As Range, cell As Range
Set r = Range("D2:E1000")
For Each cell In r
If cell > 0 Then
cell.Value = cell.Value + 1
End If
Next
Is Working for me , perhaps you want IF cell = 0 ???
Waiting for your comments to see if i anwsered your question.
I'm looking for some code that will look at Column A and as long as the cell in Column A is not blank, then the corresponding cell in Column B will equal a specific value.
So if Cell A1 <> "" then Cell B1.Value = "MyText"
And repeat until a cell in Column A is blank or empty.
To add a little more clarification, I have looked through the various loop questions asked and answered here. They were somewhat helpful. However, I'm unclear on how to get the loop to go through Column A to verify that each cell in Column A isn't blank AND in the corresponding cell in Column B, add some text that I specify.
Also, this will need to be part of a VBA macro and not part of a cell formula such as =IF
If you really want a vba solution you can loop through a range like this:
Sub Check()
Dim dat As Variant
Dim rng As Range
Dim i As Long
Set rng = Range("A1:A100")
dat = rng
For i = LBound(dat, 1) To UBound(dat, 1)
If dat(i, 1) <> "" Then
rng(i, 2).Value = "My Text"
End If
Next
End Sub
*EDIT*
Instead of using varients you can just loop through the range like this:
Sub Check()
Dim rng As Range
Dim i As Long
'Set the range in column A you want to loop through
Set rng = Range("A1:A100")
For Each cell In rng
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
cell.Offset(0, 1).Value = "My Text"
End If
Next
End Sub
Another way (Using Formulas in VBA). I guess this is the shortest VBA code as well?
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("B1:B" & lRow).Formula = "=If(A1<>"""",""My Text"","""")"
.Range("B1:B" & lRow).Value = .Range("B1:B" & lRow).Value
End With
End Sub
A simpler way to do this would be:
Sub populateB()
For Each Cel in Range("A1:A100")
If Cel.value <> "" Then Cel.Offset(0, 1).value = "Your Text"
Next
End Sub
Use the function IF :
=IF ( logical_test, value_if_true, value_if_false )