This is how my spreadsheet looks like:
enter image description here
I would like to insert a HLOOKUP formula to the cell immediate right of 58DV if the cell contains 58DV. If there is no data, nothing needs to be done. I'm still quite new to VBA so I'm not sure how can i work with formulas in VBA. Thanks
Sub sitelookup()
With Application
.ScreenUpdating = False
End With
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("C4:C1299")
For Each cel In SrchRng
If cel > 0 Then
cel.Offset(0,1).value = Application.WorksheetFunction.HLOOKUP(F4,'Raw G'!2:5,2,0)
End If
Next cel
End Sub
Try,
with worksheets("sheet1")
Set SrchRng = .Range(.cells(4, "B"), .cells(rows.count, "B").end(xlup))
For Each cel In SrchRng
If cel.value2 = "58DV" Then
'to put the formula's value into the neighboring cell
cel.Offset(0, 1).value = _
Application.HLOOKUP(.cells(cel.row, "F"), worksheets("Raw G").range("2:5"), 2, 0)
'to put the formula into the neighboring cell
'cel.Offset(0, 1).formula = _
"=HLOOKUP(F" & cel.row & ",'Raw G'!2:5, 2, 0)"
End If
Next cel
end with
Related
I have the following code... It should go through my table, picking out where column B has the value 'OSI' and column C has the value 'Notifications'. There are three rows which match this criteria.
From this I want to create a named range called 'Notif' that spans the corresponding columns from D to F for those rows, not including the B and C items.
Set NotifRng = sht.Range(sht.Range("B1"), sht.Range("C" & sht.Rows.Count).End(xlUp))
counter = 0
For Each cell In NotifRng 'loop through the range of features
If cell.Value = "Notifications" And cell.Vaue = "OSI" Then
counter = counter + 1
If counter = 1 Then
Set rng = sht.Range(cell.Offset(0, 1), cell.Offset(0, 3))
Else
Set rng = Union(rng, sht.Range(cell.Offset(0, 1), cell.Offset(0, 3))) 'build the range
End If
End If
Next cell
Debug.Print rng.Address
ThisWorkbook.Names.Add "Notif", rng
When I run the above code, only the first row returns, not all three. What am I doing wrong? I am not getting any error messages...
Any help would be very very very much appreciated!
The problem is in If cell.Value = "Notifications" And cell.Vaue = "OSI" Then, because the cell.Value cannot be both "Notifications" and "OSI".
Furthermore, you only need to loop through the first column of the range, thus: For Each cell In notifRng.Columns(1).Cells
The counter variable is not needed, if you check whether rng is assigned or not. At the end it is a good idea to check the rng again, before printing its address - If Not rng Is Nothing Then Debug.Print rng.Address
If this is the input:
Then running this code:
Sub TestMe()
Dim sht As Worksheet
Set sht = Worksheets(1)
Dim notifRng As Range
Set notifRng = sht.Range(sht.Range("B1"), sht.Range("C" & sht.Rows.Count).End(xlUp))
Dim rng As Range
Dim cell As Range
For Each cell In notifRng.Columns(1).Cells
If cell.Value = "OSI" And cell.Offset(columnoffset:=1).Value = "Notifications" Then
If rng Is Nothing Then
Set rng = sht.Range(cell.Offset(0, 1), cell.Offset(0, 3))
Else
Set rng = Union(rng, sht.Range(cell.Offset(0, 1), cell.Offset(0, 3)))
End If
End If
Next cell
If Not rng Is Nothing Then Debug.Print rng.Address
End Sub
Would deliver this:
$C$3:$E$3,$C$5:$E$5,$C$9:$E$9
This may work for you. It does away with the counter to see if a range has passed and checks the status of the Rng variable instead.
Sub Test()
Dim sht As Worksheet
Dim NotifRng As Range
Dim cell As Range
Dim Rng As Range
Set sht = ThisWorkbook.Worksheets("Sheet1")
With sht
Set NotifRng = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With
For Each cell In NotifRng 'loop through column B.
If cell.Value = "Notifications" And cell.Offset(, 1) = "OSI" Then 'Check value in column B & C.
If Rng Is Nothing Then 'If Rng doesn't contain a range then set one (columns C & E)
Set Rng = sht.Range(cell.Offset(0, 1), cell.Offset(0, 3))
Else 'If Rng already contains a range(s) then add to it.
Set Rng = Union(Rng, sht.Range(cell.Offset(0, 1), cell.Offset(0, 3))) 'build the range
End If
End If
Next cell
ThisWorkbook.Names.Add "Notif", Rng
End Sub
Hmmm - trying to delete my answer as #Vityata explains better, but it's not letting me.
I'm trying to add a lookup formula to cells in a range where the word YES appears and leave the text in all other cells in the range as they are. My code is.
Sub AddFormula()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("B1:B20")
For Each cel In SrchRng
If InStr(1, cel.Value, "Yes") > 0 Then
cel.Value = "=VLOOKUP(A1,H:I,2,0)"
End If
Next cel
End Sub
Unfortunately the cell reference 'A1' does not change as the formula is entered. Can anyone help please?
Here is simple solution to get the cell left to cel instead of always A1:
Sub AddFormula()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("B1:B20")
For Each cel In SrchRng
If InStr(1, cel.Value, "Yes") > 0 Then
cel.Value = "=VLOOKUP(A" & cel.Row & ",H:I,2,0)"
End If
Next cel
End Sub
The code doesnt look like it's supposed to change values in 'A1'. The loop is over cells in B1:B20, so only cells in B1:B20 can change. Maybe you are not getting any changes expected because your if condition is never true?
I would suggest using the Immediate Window to check if the if condition is ever true with "Debug.print. Also better to use R1C1 references like this:
Sub AddFormula()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("B1:B20")
For Each cel In SrchRng
If InStr(1, cel.Value, "Yes") > 0 Then
Debug.Print "Was true"
cel.FormulaR1C1 = "=VLOOKUP(RC[-1],C[6]:C[7],2,0)"
End If
Next cel
End Sub
I have a sheet with data in columns A to H. Some cells in column A and B have no values or are empty, but there are values in that rows other columns that is C to H. Now I have this code to do this. loop through each empty cell in B and put in the values. that is my code will fill down till the last non empty cell in B. but I get an error.
Sub filldownemptyAB()
Dim cel As Range, rng As Long
rng = Cells(Rows.Count, 1).End(xlUp).row
For Each cel In rng.Cells
With ActiveCell
.Offset(, 0).Formula = "=year(today())"
.Offset(, -1).Value = "Actual"
End With
Next cel
End Sub
the error is at this line
For each cel in rng
I believe you're looking for this:
(I edited a few times to simplify things a bit and to scan column B instead of column A)
Sub FillDownEmptyAB()
Dim c, lr
lr = ActiveSheet.UsedRange.Rows.CountLarge
For Each c In Range("B1:B" & lr)
If c.Value = "" Then
c.Offset(,-1).Value = "Actual"
c.Formula = "=YEAR(TODAY())"
End If
Next c
End Sub
Input:
Output:
A Long is not a collection of Ranges.
I think you are trying to do something like this:
Sub filldownemptyAB()
Dim cel As Range
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).row
Dim rng as Range
Set rng = Range("B" & lastRow)
For Each cel In rng
With cel
.Offset(, 0).Formula = "=year(today())"
.Offset(, -1).Value = "Actual"
End With
Next cel
End Sub
But it's hard to tell.
I'm more than new at this, and I'm having trouble sorting out For...Next loops.
I want to track to two text variables in two columns, so that when both variables are found in a row text is added to that row in a different column.
This is what I have so far:
Sub AB()
Dim Rng1 As Range
Dim Rng2 As Range
Set Rng1 = Range("B1:B100")
Set Rng2 = Range("A1:A100")
For Each cel In Rng1
If InStr(1, cel.Value, "A") > 0 Then
For Each cel In Rng2
If InStr(1, cel.Value, "B") > 0 Then
cel.Offset(0, 5).Value = "AB"
End If
Next
End If
Next cel
End Sub
You might even be able to just do this?
Sub AB()
With ActiveSheet
For I = 1 To 100
If InStr(1, .Cells(I, 2), "A") > 0 And InStr(1, .Cells(I, 1), "B") > 0 Then
.Cells(I, 6).Value = "AB" 'i think offset 5 is column F?
End If
Next
End With
End Sub
Appreciate you have an answer now, but here's a different method using Find. Always good to know several ways to do something.
Sub AB()
Dim rng As Range
Dim itemaddress As String
With Columns(1)
Set rng = .Find("A", searchorder:=xlByRows, lookat:=xlWhole)
If Not rng Is Nothing Then
itemaddress = rng.Address
Do
If rng.Offset(0, 1) = "B" Then
rng.Offset(0, 2).Value = "AB"
End If
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And itemaddress <> rng.Address
End If
End With
End Sub
You're using `cel' to step through each loop - the inner loop will get confused.
Along the vein of #findwindow answer (appeared as I was typing this). Loop just once and when a match is found check the cell next to it.
Sub AB()
Dim Rng1 As Range
Dim Rng2 As Range
Dim cel1 As Range
'Be specific about which sheet your ranges are on.
With ThisWorkbook.Worksheets("Sheet1")
Set Rng1 = .Range("B1:B100")
Set Rng2 = .Range("A1:A100")
End With
For Each cel1 In Rng1
'Check each value in column B.
If InStr(1, cel1.Value, "A") > 0 Then
'If a match is found, check the value next to it.
If InStr(1, cel1.Offset(, -1), "B") > 0 Then
cel1.Offset(, 4).Value = "AB"
End If
End If
Next cel1
End Sub
Hello stackoverflow community,
in advance, im very new to VBA and Excel Macros so pardon me for not understanding some stuff.
I have 2 sheets in Excel 2010 with 1 Table each.
Sheet 1
Sheet 2
Some rows are equal some not.
While testing some different codes, this one:
With ActiveSheet
Set Rng = Range("A1", Range("L1048576").End(xlDown))
Rng.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
End With
Managed to delete the duplicates on one sheet.
What I need it to do is:
Color the duplicates red and the uniques green, instead of deleting them.
Aditionally I need to compare the sheets with each other instead of doing it on one sheet.
I hope the question is understandable.
EDIT:
Thats what I've got so far:
Sub duplicateTest()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng1 As Range, rng2 As Range
Set ws1 = Worksheets(2)
Set ws2 = Worksheets(3)
Set rng1 = ws1.Range("B" & Rows.Count).End(xlDown)
Set rng2 = ws2.Range("D" & Rows.Count).End(xlDown)
If Range("D" & Rows.Count).End(xlDown).Value = "" Then
Else
rng2.EntireRow.Interior.Color = 7658646 ' <~~ The color for uniques
End If
For Each cell1 In rng1
For Each cell2 In rng2
If cell1.Value <> "" And cell2.Value <> "" Then
If cell1.Value = cell2.Value And cell1.Offset(0, 1).Value = cell2.Offset(0, 1).Value Then
cell2.EntireRow.Interior.Color = 255 ' <~~ The color for duplicates
End If
End If
Next cell2
Next cell1
End Sub
Changed it to this because it shall do it to the end of the column.
Set rng1 = ws1.Range("B" & Rows.Count).End(xlDown)
This one so it doesn't color the blank cells green
If Range("D" & Rows.Count).End(xlDown).Value = "" Then
Else
To color the entire row instead of 1 cell
rng2.EntireRow.Interior.Color = 7658646
cell2.EntireRow.Interior.Color = 255
The problem I have now is that it's not coloring anything. That said it's not giving me an error message either so I guess it's kind of working codewise? I can't find a mistake in the code which could cause this so I guess it has to be something else.
Thanks in advance
Regards, Crossie
You will have to take care of the range declarations to suit your workbook. It's possible to do something dynamic if that's required, but there are varying solutions depending on how your data looks.
The colors can be modified as well, of course. I've marked where the codes are located.
Sub duplicateTest()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng1 As Range, rng2 As Range
Set ws1 = Worksheets(2)
Set ws2 = Worksheets(3)
Set rng1 = ws1.Range("A1:A100")
Set rng2 = ws2.Range("A1:A100")
rng2.Interior.Color = 7658646 ' <~~ The color for uniques
rng2.Offset(0, 1).Interior.Color = 7658646 ' <~~
For Each cell1 In rng1
For Each cell2 In rng2
If cell1.Value <> "" And cell2.Value <> "" Then
If cell1.Value = cell2.Value And cell1.Offset(0, 1).Value = cell2.Offset(0, 1).Value Then
cell2.Interior.Color = 255 ' <~~ The color for duplicates
cell2.Offset(0, 1).Interior.Color = 255 ' <~~
End If
End If
Next cell2
Next cell1
End Sub
In response to your edit:
If Range("D" & Rows.Count).End(xlDown).Value = "" Then
Else
rng2.EntireRow.Interior.Color = 7658646
End If
This won't color anything, because you are saying to the compiler:
If the bottom-most cell in the sheet is empty, do nothing. If it's non-empty, color it with this value.
We can prove this by asking the compiler what address it looks at when it evaluates the expression you supplied:
? Range("D" & Rows.Count).End(xlDown).Address
$D$1048576
We can see that this results in a single cell, its location being in column D, row 1048576.
Here is my suggestion, see if this works better:
(Do note: at the top of the code, you have to change the Worksheet references so it matches the sheets you are using in your workbook. I have used numerical values, meaning "sheet number 1 and sheet number 2. You can also use the actual sheet names, like this: Worksheets("Sheet 1"))
Sub duplicateTest()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng1 As Range, rng2 As Range
Set ws1 = Worksheets(1)
Set ws2 = Worksheets(2)
Set rng1 = ws1.Range("B1", Range("B" & Rows.Count).End(xlUp).Address)
Set rng2 = ws2.Range("B1", Range("B" & Rows.Count).End(xlUp).Address)
' Let's color the entire used range. We'll fix the colors later.
Range(rng2, rng2.Offset(10)).Interior.Color = 7658646 ' <~~ The color for uniques
For Each cell1 In rng1
For Each cell2 In rng2
If cell1.Value <> "" And cell2.Value <> "" Then
' If the cells are duplicate, color them
If cell1.Value = cell2.Value And cell1.Offset(0, 1).Value = cell2.Offset(0, 1).Value And cell1.Offset(0, 10).Value = cell2.Offset(0, 10).Value Then
Range(cell2, cell2.Offset(0,10)).Interior.Color = 255 ' <~~ The color for duplicates
End If
ElseIf cell2.Value = "" Then
' If the cell in sheet 2 is empty, remove the coloring
cell2.EntireRow.Interior.Color = xlNone
End If
Next cell2
Next cell1
End Sub