The situation:
In cells "D18:D94" and "E18:94" I have dropdown lists (data validation). In an additional sheet "Sheet2" in cells "R18:94", I have a formula.
Output wanted:
If cell "E18" is not empty then insert the value from "Sheet2!U18" to cell "F18". I want to loop this for each row from range.
I made something like this, but I don't know how to loop.
If Sheets("Sheet1").Range("E18").Value <> "" Then
Sheets("Sheet1").Range("F18").Value = Sheets("Sheet2").Range("R18")
End if
I don't want to set formula in Sheet1! "F" column because I have a dynamic print area.
Try below sub-
Sub FillData()
Dim sRng As Range, Rng As Range
Set sRng = Sheets("Sheet1").Range("E18:E94")
For Each Rng In sRng
If Rng.Value <> "" Then
Rng.Offset(0, 1).Value = Sheets("Sheet2").Range("R" & Rng.Row)
End If
Next Rng
Set sRng = Nothing
End Sub
Related
Goal: Have the column header of any text in red be represented in column F of the same row as the text.
Problem: Code currently references active row, and for some reason copies F2 (which is written in red). I know the code currently would be attempting to copy/paste over a cell a few times, and I'll work that out later.
Sub CopyRed()
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("G3:BF900")
For Each row In rng.Rows
For Each cell In row.Cells
If cell.Font.ColorIndex = 3 Then
Cells(2, ActiveCell.Column).Copy
Range("F" & (ActiveCell.row)).Select
ActiveSheet.Paste
End If
Next cell
Next row
End Sub
Not sure if I follow your logic. Your problem is that you reference active cell but you are not defining it or changing it other than through the pasting. I think you mean to reference cell (?)
Sub CopyRed()
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("G3:BF900")
For Each row In rng.Rows
For Each cell In row.Cells
If cell.Font.ColorIndex = 3 Then
Cells(2, cell.Column).Copy Range("F" & cell.row)
End If
Next cell
Next row
End Sub
You are never changing the active cell, so the copy command is always called on row 2 of the active cell, which much be in the F column. I changed the code below to fix the issue.
Sub CopyRed()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet ' this should be improved to point at the correct worksheet by name
Set rng = ws.Range("G3:BF900")
For Each row In rng.Rows
For Each cell In row.Cells
If cell.Font.ColorIndex = 3 Then
cell.Copy
ws.Range("F" & (cell.row)).PasteSpecial
End If
Next cell
Next row
End Sub
I have a vba code that copies a file multiple times and renames the output after a list of names in column D from sheet "Linkuire".
Column D is full of concatenate formulas that bring data into cells till D1000.
When the concatenate formulas return "" (as in nothing) i want the code to ignore that cell.
' the range of cells that contain the rename list
With ActiveWorkbook.Sheets("Linkuire")
Set rRenameList = .Range("D2", .Cells(.Rows.Count, "D").End(xlUp))
End With
Now it just takes into account all D2 to D1000 cells even if some are = ""
How can I make the code ignore all cells where the return of the concatenate is "" ? (I have the same problem with a vba code that converts a certain sheet into pdf - with data got from concatenate formulas. It converts all cells even if concatenate return "" and is blank)
Thank you..
edited since pure SpecialCells() approach wouldn't work
You could use following two approaches and avoid looping:
AutoFilter() and SpecialCells() approach:
With ActiveWorkbook.Sheets("Linkuire")
With .Range("D1", .Cells(.Rows.count, "D").End(xlUp))
.AutoFilter Field:=1, Criteria1:="<>" '<--| filter out blanks
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Set rRenameList = .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
End With
.AutoFilterMode = False
End With
Formula and SpecialCells() approach
With ActiveWorkbook.Sheets("Linkuire")
With .Range("D2", .Cells(.Rows.count, "D").End(xlUp))
.Offset(, 1).FormulaR1C1 = "=IF(RC[-1]="""", 1,"""")"
Set rRenameList = .Offset(, 1).SpecialCells(xlCellTypeFormulas, xlNumbers).Offset(, -1)
.Offset(, 1).ClearContents
End With
End With
in this approach you're writing a formula in a "helper" column I chose to be the adjacent to the right. It can be adjusted to any other offset
This should work. It will loop through your range, and only add the cell address to your rRenameList when the length is greater than or equal to 1.
Sub Test()
' Adapted from http://stackoverflow.com/a/8320884/4650297
Dim rng1 As Range, rRenameList As Range, cel As Range
With ActiveWorkbook.Sheets("Linkuire")
Set rng1 = .Range("D2", .Cells(.Rows.Count, "D").End(xlUp))
End With
For Each cel In rng1
If Len(cel) >= 1 Then
If Not rRenameList Is Nothing Then
Set rRenameList = Union(rRenameList, cel)
Else
' the first valid cell becomes rng2
Set rRenameList = cel
End If
End If
Next cel
Debug.Print rRenameList.Address
End Sub
I am looking for a VBA code that could help me apply VLOOKUP on column "L" but only cells with specific text.
For example if the value in cell on column "L" is "#N/A", then it should replace it with the value returned from the VLOOKUP. If the value is not "#N/A", it should not change the actual value in the cell.
Here is the code that I tried
Range("L:L").NumberFormat = "mm/dd/yyyy"
lastrow6 = Range("K" & Rows.Count).End(xlUp).Row
Range("L3").Formula = "=IF(ISNA(VLOOKUP(A3,'[Ref_Data_Vivar.xlsx]Legacy PCO'!$A$2:$B$25628,2,0)),"""",IF(ISERROR(FIND(""#N/A"", VLOOKUP(A3,'[Ref_Data_Vivar.xlsx]Legacy PCO'!$A$2:$B$25628,2,0)))"
Range("L3").AutoFill Destination:=Range("L3:L" & lastrow3)
Range("L:L").value = Range("L:L").value
Something like this should do the trick:
Sub FindErrorInRange()
Dim cell As Variant
Dim rng As Range
'data range:
Set rng = Sheet1.Range("A1:A10")
For Each cell In rng
'checks for '#N/A error:
If CVErr(cell) = CVErr(xlErrNA) Then
'do something here:
MsgBox ("error found")
'example:
cell.Value = Application.WorksheetFunction.Lookup() '<-- insert your lookup values
End If
Next cell
End Sub
i am a complete noob to vba's but is this possible?#
I need to write a VBA to convert formula to value but leave as formula if the first column is empty
Is it what you need:
Sub test()
Dim rng As Range
Dim cell As Range
'change Sheet1 to suit
With ThisWorkbook.Worksheets("Sheet1")
'range with formulas
Set rng = .Range("B1:B100")
For Each cell In rng
If Trim(.Range("A" & cell.Row)) <> "" Then cell.Value = cell.Value
Next
End With
End Sub
How can I create a macro that will add a day in one cell and subtract a day in another cell at the same time? Here is what I have so far.
Sub ChangeDates()
Dim cell As Range
For Each cell In Range("B:B")
cell.Value = cell.Value + 1
Next cell
For Each cell In Range("C:C")
cell.Value = cell.Value - 1
End Sub
I know you've accepted an answer, but I would like to offer this approach, which is even faster and more efficient than looping through all those cells.
If your dates are in Column A, then Column B will hold date +1 and Column C will hold date -1
Option Explicit
Sub ChangeDates()
Dim myRange As range
Dim mySheet As Worksheet
Set mySheet = Sheets("Sheet7") 'change to your sheet
With mySheet
Set myRange = .range("A1:A" & .range("A" & .Rows.Count).End(xlUp).Row)
myRange.Offset(, 1).FormulaR1C1 = "=RC[-1]+1"
myRange.Offset(, 2).FormulaR1C1 = "=RC[-2]-1"
End With
End Sub
Offset to the rescue!!
Sub ChangeDates()
Dim cell As Range
For Each cell In Range("B:B")
cell.Value = cell.Value + 1
cell.offset(0,1).value = cell.offset(0,1).value - 1
Next cell
End Sub
Another thing you may consider is either looking at usedrange to not have to iterate through all of column B or put in a check to make sure the cells aren't blank... Just faster, better coding and stops you from having bad values where the cells were originally blank...
Sub ChangeDates()
Dim cell As Range
For Each cell In Intersect(Range("B:B"), ActiveSheet.UsedRange)
cell.Value = cell.Value + 1
cell.Offset(0, 1).Value = cell.Offset(0, 1).Value - 1
Next cell
End Sub