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
Related
I am trying to get a faster and more efficient code than this one, as range will increase a lot over time, so I will need to substitute For Each.
The macro would look up the value "Monday" through each cell of a column and, if found, it would return the value "Substract" in the preceding cell in column A.
Sub ForEachTest()
Dim Rng As Range
Set Rng = Range("B3:B1000")
For Each cell In Rng
If cell.Value = "Monday" Then
cell.Offset(0, -1) = "Substract"
End If
Next cell
End Sub
Loop within VBA rather than on the worksheet:
Sub faster()
Dim arr()
arr = Range("A3:B1000")
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, 2) = "Monday" Then arr(i, 1) = "Substract"
Next i
Range("A3:B1000") = arr
End Sub
EDIT#1:
This version addresses BigBen's concern that column B should not be overwritten so as to preserve any formulas in that column. Only column A is overwritten here:
Sub faster2()
Dim arr(), brr()
arr = Range("A3:A1000")
brr = Range("B3:B1000")
For i = LBound(brr, 1) To UBound(brr, 1)
If brr(i, 1) = "Monday" Then arr(i, 1) = "Substract"
Next i
Range("A3:A1000") = arr
End Sub
You can avoid the loop by filtering your data and working with the resulting visible set of data.
This will only modify the cells in Column A when Column B = Monday. All other cells remain as-is
Sub Shelter_In_Place()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
lr As Long
lr = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
ws.Range("A1:B" & lr).AutoFilter Field:=2, Criteria1:="Monday"
ws.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).Value = "Subtract"
ws.AutoFilterMode = False
End Sub
Try using Evaluate
Sub Test()
With Range("A3:A" & Cells(Rows.Count, 2).End(xlUp).Row)
.Value = Evaluate("IF(" & .Offset(, 1).Address & "=""Monday"",""Substract"","""")")
End With
End Sub
I have some history working with VBA, but can't seem to find the solution to this problem. I found an iteration process to select a cell, do a process, and then select the next cell and do the process again, until NULL. I am having a problem outputting each of the processes solutions into the next column. Here is what I have:
Sub Name ()
Dim X As Integer
Dim MyString as String
Application.ScreenUpdating = False
NumRows = Range("D2", Range("D2").End(xlDown)).Rows.Count
Range("D2").Select
For X = 1 To NumRows
MyString = ActiveCell.Value
MyString = Right(MyString, Len(MyString)-6)
Range("I2 to I#").Value = MyString
ActiveCell.Offset(1,0).Select
Next X
End Sub
Range("I2 to I#").Value = MyString is the line that I need help with. I need it to increment to I3, I4, I5, etc. until it reaches NumRows count.
When working with Cells the best way to loop through them is For Each Cell in Range so taking this and as comments told you to avoid selecting, this should help you:
Option Explicit
Sub Name()
Dim C As Range, MyRange As Range
Dim LastRow As Long
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("MySheet") 'Change MySheet for your working sheet name
LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row 'last row on column D
Set MyRange = .Range("D2:D" & LastRow) 'declare your working range
For Each C In MyRange
If Not C = vbNullString Then .Cells(C.Row, "I") = Right(C, Len(C) - 6)
Next C
End With
Application.ScreenUpdating = True
End Sub
Another solution is Do Until. You could use this method if you dont have empty cells in the middle of your data.
Option Explicit
Sub Test()
Dim StartingPoint As Long
StartingPoint = 2 'Set the line to begin
With ThisWorkbook.Worksheets("Sheet1") 'Set the worksheet
Do Until .Cells(StartingPoint, "D").Value = "" 'Repeat the process until you find empty cell
.Cells(StartingPoint, "I").Value = Right(.Cells(StartingPoint, "D").Value, Len(.Cells(StartingPoint, "D").Value) - 6)
StartingPoint = StartingPoint + 1
Loop
End With
End Sub
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
This question already has answers here:
Delete Row based on Search Key VBA
(3 answers)
Closed 8 years ago.
Hey guys I am trying to write a code that deletes rows having values that are found using a formula. The problem is every other row is a #VALUE!, which I cannot change due to the setup of the report. In the end I want to delete all rows that have #VALUE! and any row that has values that are less than .75 in Column H.
The code I tried is as shown below:
Private Sub CommandButton1_Click()
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("H1:H2000"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) < .75 Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub
Any help or tips would be appreciated.
I suggest stepping backwards through the rows so that when a row is deleted you don't lose your place.
Assuming that you want to look at cells contained in column H you could do something like this:
Sub Example()
Const H As Integer = 8
Dim row As Long
For row = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
On Error Resume Next
If Cells(row, H).Value < 0.75 Then
Rows(row).Delete
End If
On Error GoTo 0
Next
End Sub
my code is an alternative to the other answers, its much more efficient and executes faster then deleting each row separately :) give it a go
Option Explicit
Sub DeleteEmptyRows()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim i&, lr&, rowsToDelete$, lookFor$, lookFor2$
'*!!!* set the condition for row deletion
lookFor = "#VALUE!"
lookFor2 = "0.75"
Set ws = ThisWorkbook.Sheets("Sheet1")
lr = ws.Range("H" & Rows.Count).End(xlUp).Row
ReDim arr(0)
For i = 1 To lr
If StrComp(CStr(ws.Range("H" & i).Text), lookFor, vbTextCompare) = 0 Or _
CDbl(ws.Range("H" & i).Value) < CDbl(lookFor2) Then
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr) - 1) = i
End If
Next i
If UBound(arr) > 0 Then
ReDim Preserve arr(UBound(arr) - 1)
For i = LBound(arr) To UBound(arr)
rowsToDelete = rowsToDelete & arr(i) & ":" & arr(i) & ","
Next i
ws.Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Delete Shift:=xlUp
Else
Application.ScreenUpdating = True
MsgBox "No more rows contain: " & lookFor & "or" & lookFor2 & ", therefore exiting"
Exit Sub
End If
If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
Set ws = Nothing
End Sub
Try:
Private Sub CommandButton1_Click()
Dim rng As Range, cell As Range, del As Range, v As Variant
Set rng = Intersect(Range("H1:H2000"), ActiveSheet.UsedRange)
For Each cell In rng
v = cell.Text
If v < 0.75 Or v = "#VALUE!" Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
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