I am trying to add vlookup formulas to multiple columns (E:I) when the corresponding cell in column "D" is blank. For example when cell D113 and down are blank, I want to add "=VLOOKUP(A2,Sheet4!$A:$L,5,False)" to cells E113:and down and then repeat for colums G,H,I,etc.
But the code I have now as shown below adds the vlookup to all cells in column E & lastrow, overwriting existing data above E113. Code is as follows:
Sub PrevInactives()
Dim ws As Worksheet
Dim lastrow As Long
lastrow = Range("A2").End(xlDown).Row
For Each Cell In Sheets(1).Range("D2:D" & lastrow)
Select Case Cell.Value
Case ""
If Cell.Offset(1, 0) = "" Then
Range("E2:E" & lastrow).Formula = "=VLOOKUP(A2,Sheet3!$A:$L,5,FALSE)"
End If
End Select
Next Cell
End Sub
Does anyone have a solution for my dilemma?
Thanks,
Jason
EDIT, 9/26/17: Below is the updated code I added in, but when I run this macro, nothing happens.
Sub PrevInactives()
Dim r As Long
For r = 2 To lastrow
lastrow = Range("A2").End(xlDown).Row
If IsEmpty(Cells(r, 4).Value) And Not IsEmpty(Cells(r - 1, 4).Value) Then
Range(Cells(r, 5), Cells(r, 9)).Formula = "=VLOOKUP($A2" & r & ",Sheet4!$A:$L,False)"
End If
Next r
End Sub
If I'm understanding correctly, you want to have inside of your loop something such as:
If IsEmpty(Cells(r,4).Value) AND Not IsEmpty(Cells(r-1,4).Value) Then
'Insert vlookup stuffs
End If
Rather than using For Each as the loop, you can loop For r = 2 to LR using the above example:
Dim r as Long
For r = 2 to lastrow
If IsEmpty(Cells(r,4).Value) AND Not IsEmpty(Cells(r-1,4).Value) Then
Range(Cells(r,5),Cells(r,9)).Formula= "=VLOOKUP($A" & r & ",Sheet3!$A:$L,5,FALSE)"
End If
Next r
Essentially, the issue is that you are using:
Range("E2:E" & lastrow).Formula = "=VLOOKUP(A2,Sheet3!$A:$L,5,FALSE)"
When you want Cell.Formula = ""; you are adding the formula to all of those cells if the case is ever true.
Edit, 20170926:
Fixing your code:
Sub PrevInactives()
Dim r As Long, lastrow as Long
lastrow = Range("A2").End(xlDown).Row 'Need to define before looping
'You could use lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lastrow
If IsEmpty(Cells(r, 4).Value) And Not IsEmpty(Cells(r - 1, 4).Value) Then
Range(Cells(r, 5), Cells(r, 9)).Formula = "=VLOOKUP($A" & r & ",Sheet4!$A:$L,False)" 'You had in A2&r, so it would be A22, A23, ..., A2&LR
End If
Next r
End Sub
Related
I am trying to have a macro auto-sum the bottom of column L each time I run it while it takes into account that the length of the column varies. I had this code that auto-summed the bottom of a column G, so I switched the G to an L but it is not working as intended. Why is that? Could someone please make an edit to the code so it automatically sums the bottom of column even though the range may vary weekly?
Sheets("Report").Select
Const SourceRange = "A:L"
Dim NumRange As Range, formulaCell As Range
Dim SumAddr As String
Dim c As Long
For Each NumRange In Columns(SourceRange).SpecialCells(xlConstants, xlNumbers).Areas
SumAddr = NumRange.Address(False, False)
Set formulaCell = NumRange.Offset(NumRange.Count, 0).Resize(1, 1)
formulaCell.Formula = "=SUM(" & SumAddr & ")"
c = NumRange.Count
Next NumRange
This would add a SUM total at the bottom of each column between A & L.
Public Sub Add_Total()
Dim ColumnNumber As Long
Dim LastRow As Long
With ThisWorkbook.Worksheets("Report")
For ColumnNumber = 1 To 12
LastRow = .Cells(.Rows.Count, ColumnNumber).End(xlUp).Row
With .Cells(LastRow + 1, ColumnNumber)
.FormulaR1C1 = "=SUM(R2C:R[-1]C)"
.Font.Bold = True
End With
Next ColumnNumber
End With
End Sub
To add it to just column L you could change the code to:
Public Sub Add_Total1()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Report")
LastRow = .Cells(.Rows.Count, 12).End(xlUp).Row
With .Cells(LastRow + 1, 12)
.FormulaR1C1 = "=SUM(R2C:R[-1]C)"
.Font.Bold = True
End With
End With
End Sub
I don't have enough reputation yet to add a comment to reply to your question to Darren - but all you have to do is delete the whole line with "Next" in it from his second set of code; it was the end of the "for" loop that he removed from his first set of code and should have been deleted.
I am trying to match a value from a cell (grid_2.range "A1") and grid_2.range("B1") with a column P on a sheet named grid_2 ("Grid2") to copy all the row where there value is located. Therefore, I will need to check on my data and copy/paste the entire row to another sheet maned grid. But for some reason my code loops but only find the match and copy and paste once.
Sub new_copyPaste()
Dim targetSh As Worksheet
Dim i As Variant
Dim lastRow As Long
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
Position = WorksheetFunction.Match(grid_2.Range("A1"), Worksheets("Grid2").Columns(16), 0)
If grid_2.Cells(i, 16).Value = grid_2.Range("A1") Then
Worksheets("Grid2").Rows(Position).Copy
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
Position = WorksheetFunction.Match(grid_2.Range("B1"), Worksheets("Grid2").Columns(16), 0)
If grid_2.Cells(i, 16).Value = grid_2.Range("B1") Then
Worksheets("Grid2").Rows(Position).Copy
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
End Sub
Maybe do you know what I am doing wrong?
I thought about using VLookup, but after researching, it seems that function match would be more appropriate.
I am open for suggestions :)
Match only returns the first match and is not needed here:
Sub new_copyPaste()
Dim lastRow As Long
Dim i As Long
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
If grid_2.Cells(i, 16).Value = grid_2.Range("A1") Then
Worksheets("Grid2").Rows(i).Copy
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
If grid_2.Cells(i, 16).Value = grid_2.Range("B1") Then
Worksheets("Grid2").Rows(i).Copy
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
End Sub
I have excel with 5 different sheets.
sheet3 and sheet4 i want delete rows based on the single column cell value.
in sheet 3 i want to delete rows based on H column cell values if H2="#N/A" and H503="#N/A" then delete entire rows.
in sheet 4 i want to delete rows based on b column cell values if B2="320857876",B3="32085678",B4="12133435" the delete the entire rows where B column cell values starts with 302.
and i want to delete all Data from 'C' column
My excel sheet is like this
Using excel file
Sub Create()
Dim LastRow As Long
Dim i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i) = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
You've got a few requirements there and your code is fairly light but regarding the #N/A part of it, you can't just test for that text using the value approach, which is the default property returned for a range object.
Sub Create()
Dim LastRow As Long, i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i).Text = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
... you need to use .Text to get that to work, or, If IsError(Range("B" & i)) Then is another approach.
The rest of your requirements is just logic. The rest of your code is relatively sound so you just need to work through it.
I hope that helps.
Sub delete_rows()
Dim sheet As Worksheet, cell As Range
Count = 1
For Each sheet In ThisWorkbook.Worksheets
If Count = 3 Then
lastrow = sheet.Cells(sheet.Rows.Count, "H").End(xlUp).Row
Set Rng = sheet.Range("H1:H" & lastrow)
For i = Rng.Cells.Count To 1 Step -1
If Application.WorksheetFunction.IsNA(Rng(i).Value) Then
Rng(i).EntireRow.Delete
ElseIf Rng(i).Value = "#NA" Then
Rng(i).EntireRow.Delete
End If
Next
ElseIf Count = 4 Then
lastrow = sheet.Cells(sheet.Rows.Count, "B").End(xlUp).Row
Set Rng = sheet.Range("B1:B" & lastrow)
Debug.Print (Rng(4).Text)
If Rng(2).Value = "320857876" And Rng(3).Value = "32085678" And Rng(4).Value = "12133435" Then
For i = Rng.Cells.Count To 1 Step -1
If Left(Rng(i).Value, 3) = "302" Then
Rng(i).EntireRow.Delete
End If
Next
End If
lastrow = sheet.Cells(sheet.Rows.Count, "C").End(xlUp).Row
Set Rng = sheet.Range("C1:C" & lastrow)
For Each cell In Rng
cell.Value = ""
Next cell
End If
Count = Count + 1
Next
End Sub
I have a column of data in excel. I want to loop through the data and combine the contents into a single string. I can specify the cell range, but what if the range is unknown. I want to be able to loop until the cell becomes empty. here is what I have so far.
Sub ConcatenationLoop()
Dim rng As Range, i As Integer
Set rng = Range("A1", "A5")
For i = 1 To rng.Rows.Count
With Range("B1")
If .Value = "" Then
.Value = rng.Range("A" & i)
Else
.Value = .Value & ", " & rng.Range("A" & i)
End If
End With
Next
is it possible to combine with something like:
Do Until IsEmpty(ActiveCell)
Much help is appreciated!
End Sub
With Worksheets("YourSheetName")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Loop it to LastRow.
Get the first empty cell from the top using
lLastRow = sheet.Cells(1, 2).End(xlDown).Row
The use this in your for loop
For i = 1 To lLastRow
You could use the following skeleton:
Sub ALoop()
Dim r As Long
r = 2 '//Start row
While Len(Cells(r, "A")) > 0 '//Or While Not IsEmpty(...)
'// Your code
r = r + 1 '//Don't forget to increment row
Wend
End Sub
I have two columns A and B with numbers as values.
In C1 I want =A1 + B1
In C2 I want =A2 + B2
and so on. I have written the following VBA code - while it works it adds "0" after the end of the last row in range.
Let's assume my last row is A10. It adds "0" in C11 when I run the code.
How do I prevent this?
Sub macro()
Dim R As Long
R = 1
Do
Cells(R, "C").Select
R = R + 1
ActiveCell.Formula = "=sum(" & ActiveCell.Offset(0, -2) & "," &
ActiveCell.Offset(0, -1) & ")"
Loop Until IsEmpty(ActiveCell.Offset(0, -2))
End Sub
Just replace your Until condition to the following string:
Loop Until IsEmpty(ActiveCell.Offset(1, -2))
That will check the right cell for being empty. The rest of your code should remain intact.
Take a look at Do Until and Do While and While.
If you really want to iterate over cells you may go ahead. But here a method using Arrays, this will by all means reduces any performance drops that you would get looping over cells...
Option Explicit
Sub AddToRigh()
Dim i As Integer
Dim vArr As Variant
Dim LastRow As Long
'--assume you are working on Sheet 1
LastRow = Sheets(1).Cells(Rows.Count, Range("A1").Column).End(xlUp).Row
ReDim vArr(1 To LastRow)
For i = LBound(vArr) To UBound(vArr)
vArr(i) = "=Sum(RC[-2]:RC[-1])"
Next i
'--output this entire array with formulas into column C
Sheets(1).Range("C1").Resize(UBound(vArr)) = Application.Transpose(vArr)
End Sub
Output:
I'm by no means an expert in vba, but you could do this:
Sub macro()
Dim R As Long
R = 1
Do While Not IsEmpty(ActiveCell.Offset(0, -2))
Cells(R, "C").Select
R = R + 1
ActiveCell.Formula = "=sum(" & ActiveCell.Offset(0, -2) & "," &
ActiveCell.Offset(0, -1) & ")"
Loop
End Sub
I thought I'd recommend a slightly different course of action, just to give you ideas :):
Sub macro()
Dim found As Range
Set found = Range("A:A").Find("*", after:=Range("A1"), searchdirection:=xlPrevious)
If Not found Is Nothing Then
Range(Range("A1"), found).Offset(0, 2).FormulaR1C1 = "=RC[-2]+RC[-1]"
End If
End Sub