I need to select a range of data in column Q that meet criteria found in column A (specifically, I wish to select only those cells which correspond to non-"" values in column A). The resulting range of selected cells will be non-contiguous.
I then want to copy these cells and paste their values in column K. The pasted values should retain the same row references as the copied range; basically, I'm just taking the values in the copied range and pasting the values x many columns to the left.
The problem I'm encountering is that it seems to only copy the final value in column Q and then paste this value in column K. So, I seem to be getting it to paste in the right place, but it's not copying the way I want it to.
The code I've written can be found below.
Option Explicit
Sub NonConRngPaste()
Dim rCell As Range
Dim rRng As Range
Dim r As Range
Dim pasteRng As Range
For Each rCell In Range("A1:A1000")
If rCell.Value <> "" Then
If rRng Is Nothing Then
Set rRng = rCell
Else
Set rRng = Application.Union(rRng, rCell)
End If
End If
Next
Set pasteRng = rRng.Offset(0, 10)
For Each r In rRng.Offset(0, 16).Cells
pasteRng.Value = r.Value
Next
End Sub
May as well be simpler?
Sub NonConRngPaste()
Dim c As Range
Application.Screenupdating = False
For Each c In Range("A1:A1000").cells
If len(c.value) > 0 Then
with c.EntireRow
.Columns("K").Value = .Columns("Q").Value
end with
End If
Next
End Sub
Related
I have code that will go to a range and insert a formula all the way down. The below code will go to range N17:N160 and insert a relative formula.
Sub Macro9()
Range("n17:n160").FormulaR1C1 = "=IF(RC[-11]="""","""",IFERROR(VLOOKUP(RC[-11],R17C42:R160C53,7,FALSE),""""))"
End Sub
It works. However, I need to add a level where it looks at range B17:B160 and any cell in that range that has a "Y" in it will not update with the formula, whereas any one without a "Y", will update. Basically if and row has a Y in column B, don't put the formula in, for every other cell in the range, do put the formula in.
Thanks
First time posting, sorry if I didn't format everything correctly.
You'll need to build a range reference that meest your criteria for adding the Formula,
Something like
Sub Macro9()
Dim rng As Range, rngFiltered As Range
Dim dat As Variant
Dim idx As Long
Set rng = Range("n17:n160")
dat = rng.Offset(0, -12).Value2 ' Column B data
rng.ClearContents ' Clear existing data from range
For idx = 1 To UBound(dat)
If dat(idx, 1) <> "y" Then
If rngFiltered Is Nothing Then
Set rngFiltered = rng.Cells(idx, 1)
Else
Set rngFiltered = Application.Union(rngFiltered, rng.Cells(idx, 1))
End If
End If
Next
rngFiltered.FormulaR1C1 = "=IF(RC[-11]="""","""",IFERROR(VLOOKUP(RC[-11],R17C42:R160C53,7,FALSE),""""))"
End Sub
In Range ("A2:A10") I have a vlookup equation.
I want to select the active cell in that range, if it has a value and ignore the other cells with the formula in the same range
This will Select the first cell in the range that does not have a formula:
Sub FindValue()
Dim rng As Range, r As Range
Set rng = Range("A2:A10")
For Each r In rng
If r.HasFormula Then
Else
r.Select
Exit Sub
End If
Next r
End Sub
If all the cells in the range have formulas, Selection is not changed.
If in range "A2:A10" you have formulas, but also cells without any formula, you can put the last one category in another range in this way:
Dim rng As Range, c As Range
Set rng = Range("A2:A10")
Set rng = rng.SpecialCells(xlCellTypeConstants) 'only cells without formula
For Each c In rng.cells
c.Select
Debug.Print c.Address 'if you want the first one, put here Exit For
Next
If no cells without formula, the above code will raise an error. It can be caught with some error handling, but I only tried showing a shor way of doing it.
Edit: I should clarify what I was trying to do. I have a list of values in column D through H and sometimes I may not have any values in the top most rows (they then equal 0, usually 40 rows or so). I want to make it so I don't have to scroll down to the rows that do have values not equaling zero. So I thought it would be easiest to hide the rows that have values equaling zero. But I have values in column A that I don't want to hide. I didn't realize I couldn't hide rows in a specific column without hiding the whole row. I need to rethink how I want to do this.
Original post: I am new to VBA, please bear with me. I have been copy and pasting different snippets of code, trying to get something to work.
I want to loop through all cells in column D through H and have the cells that equal zero to hide themselves. I plan on reusing this sheet so I want the cells to unhide themselves when the value is above zero again.
Here is my code:
Private Sub Hide_Cells_If_zero()`enter code here`
Dim targetRange As Range, po As Long, i As Long
Set targetRange = Columns("D:H")
po = targetRange.Count
With targetRange
For i = 1 To po
If .Cells(i, 1).Value = 0 Then
.Rows(i).Hidden = True
End If
Next
End With
End Sub
Hide Rows With Criteria
This will hide each row where the value of any cell in columns D:H evaluates to 0.
The Code
Option Explicit
Private Sub Hide_Cells_If_zero()
Dim sRng As Range
Set sRng = Columns("D:H")
Dim tRng As Range
Dim rRng As Range
Dim cel As Range
For Each rRng In sRng.Rows
For Each cel In rRng.Cells
If cel.Value = 0 Then
If Not tRng Is Nothing Then
Set tRng = Union(tRng, cel)
Else
Set tRng = cel
End If
Exit For
End If
Next cel
Next rRng
If Not tRng Is Nothing Then
tRng.EntireRow.Hidden = True
End If
End Sub
I have a spreadsheet that has hidden rows 17-111. Data is added to three cells in each row (Columns P,Q & R).
The data comes from Userforms where the user has three option buttons to choose from. Depending on the option, the result of either "Pass", "Fail" or "NA" is populated into each of the cells in the range P17-R111.
I need to unhide all rows where "Fail" is in any of the P, Q or R column cells for that row.
e.g. If cell R57 is a "Fail" and cell P66 is "Fail", then the rows 57 and 66 need to be unhidden.
I have tried variations of code found searching the net, but I get a result where rows are unhidden only where column P has a "Fail", not where the P cell has no fail but other cells in the same row do.
e.g. If cell P57 has a "Pass", but cell R57 has a fail, the row remains hidden.
This is my latest (and more simple) attempt:
Private Sub CommandButton1_Click()
Dim cel As Range
Dim RangeToUnhide As Range
For Each cel In Worksheets("Sheet1").Range("P17:R111")
If cel = "Fail" Then
If RangeToUnhide Is Nothing Then
Set RangeToUnhide = cel
Else
Set RangeToUnhide = Union(RangeToUnhide, cel)
End If
End If
Next
RangeToUnhide.EntireRow.Hidden = False
End Sub
I tried changing the range to ("P17:P111") and then run two further copies of the code for ranges in Q and R. All I get is rows that unhide where the P cell is a 'Fail", the Q and R cells are ignored.
Use this Code
Sub Hide()
Dim cel As Range
Dim RangeToUnhide As Range
For Each cel In Worksheets("Sheet1").Range("A7:B11")
'Change Name of Sheet & Range as per your use
If cel = "A" Then
'Change Value as per your use
If RangeToUnhide Is Nothing Then
Set RangeToUnhide = cel
Else
Set RangeToUnhide = Union(RangeToUnhide, cel)
End If
End If
Next
RangeToUnhide.EntireRow.Hidden = True
End Sub
The above code is for hide use this for unhide
Sub Unhide()
Dim cel As Range
Dim RangeToUnhide As Range
For Each cel In Worksheets("Sheet1").Range("A7:B11")
'Change Name of Sheet & Range as per your use
If cel = "A" Then
'Change Value as per your use
If RangeToUnhide Is Nothing Then
Set RangeToUnhide = cel
Else
Set RangeToUnhide = Union(RangeToUnhide, cel)
End If
End If
Next
RangeToUnhide.EntireRow.Hidden = False
End Sub
Is there a way to, when grabbing all numbers in column "B" by using the .SpecialCells(xlCellTypeConstants, 1), to also copy a cell in the same row?
Example:
Let's say the script found cells B2, B4, B5 with numbers. How would I also copy D2, D4, and D5? Can I do that and still use specialcells? Ultimately, I'd like to copy/paste those values into columns A & B on another sheet.
Thanks!
Dim strOutputFile As Variant
Dim wbkOut As Workbook
Dim tenln As Range
Dim tenlnPaste As Range
Dim wbkVer As Workbook
If strOutputFile(u) Like "*Lines.csv" Then
With wbkOut.Worksheets(1)
Set tenln = wbkOut.Worksheets(1).Cells(Rows.Count, 2).End(xlUp)
Set tenlnPaste = wbkVer.Worksheets("TLines").Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(tenln.Rows.Count, 1)
wbkOut.Worksheets(1).Range("B:B").SpecialCells(xlCellTypeConstants, 1).Copy
With wbkVer.Worksheets("TenLines")
tenlnPaste.PasteSpecial xlPasteValues
End With
End With
End If
Yes. It's actually very easy. Do like below:
Dim rngConst as Range
On Error Resume Next
Set rngConst = wbkOut.Worksheets(1).Range("B:B").SpecialCells(xlCellTypeConstants, 1)
If Not rngConst is Nothing Then
rngConst.Copy
'do your pasting
Set rngConts = rngConst.Offset(,2) 'for moving from B to D
rngConst.Copy
'do your pasting
End If
On Error Go To 0
You could also do this, to get it all into 1 copy area:
Dim rngConst as Range
On Error Resume Next
If Not rngConst is Nothing
Set rngConst = wbkOut.Worksheets(1).Range("B:B").SpecialCells(xlCellTypeConstants, 1)
Set rngConst = Range(rngConst, rngConst.Offset(,2))
rngConst.Copy
'do your pasting
End If
On Error Go To 0
But this will copy the data onto the new sheet into two contiguous columns. It will not copy from B to B and D to D, for instance.