I'm trying to find a way to refer a range from another range for example,
A range that holds the cells "A5:A10", 6 cells are in that range. What is needed is the range next to it which is "B5:B10".How can I refer it when there is already a range object ("A5:A10" in this case") to the range next it.
Dim R As Range
Dim A As Range
Set R = R("A5:A10").Select
Set R =
'Code to refer to next column is here
Sorry this could be the wrong syntax to start off with , it's been a while since I coded in vba, it's just to clarify what's is needed solve this.
Try this:
Sub setRanges()
Dim ws As Worksheet
Dim rngA As Range
Dim rngB As Range
'set the worksheet -- Adjust the worksheet name as required
Set ws = ThisWorkbook.Worksheets("Sheet1")
'set the first range to a range in the worksheet
Set rngA = ws.Range("A5:A10")
' set the second range to an offest of the first range
' in this case, use an offset of one column, with the same row
' ... remember the offset command takes rows in the first parameter
' ... and the second parameter is for the columns
Set rngB = rngA.Offset(0, 1)
' so, zero row offset, i.e. stay in the same row
' and 1 column offset to get the rngB for one column to the right of rngA
rngB.Select
' don't use Select in your code. This is just to demo.
End Sub
Related
I want to set the values of a column within the current selected range. For example, the current selected range (which could vary) is A5:D10, I want the values in column B of the range to be "Something". I'm guessing it would be something like:
ActiveCell.Columns("B").Value="Something"
Thanks.
You could also use the Intersect() function...
Sub Intersection_Example()
Dim rngB As Range
Dim rngResult As Range
Set rngB = Columns("B")
Set rngResult = Intersect(Selection, rngB)
rngResult.Value = "Something"
End Sub
I have some code that is working fine, but it is not selecting and pasting the last row of data.
Column AL has a value in every other row e.g. rows 1,3,5 (AL1:AL2,AL3:AL4, AL5:AL6 are merged cells). The other columns are not merged and have values in rows 1-6). When I run the VBA code, row 6 is not being included (all other data is being pasted correctly).
I'm trying to select the cells range and then offset by 1 row (to try and pick up row 6), but that does not seem to be working. I can't find a solution.
Dim lr As Long
Dim drng As Range 'dest range
Dim srng As Range 'source range
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
lr = ws.Range("A1").SpecialCells(xlCellTypeLastCell).Row
Set srng = ws.Range("AL1:AP" & lr)
Set drng = SumSh.Range("B" & Rows.Count).End(xlUp)(2)
Set drng = drng.Resize(srng.Rows.Count, srng.Columns.Count)
drng.Value = srng.Value
Next ws
After correcting your example code to ws.Range("AL1:AP" & lr) it ran without incident or missing any rows. The target cells in the first column were not merged but all rows were there.
Sub gettit()
Dim lr As Long
Dim drng As Range 'dest range
Dim srng As Range 'source range
Dim ws As Worksheet, SumSh As Worksheet
Set SumSh = Worksheets("Sum")
For Each ws In ActiveWorkbook.Worksheets
With ws
If .Name = "Sum" Then Exit For
lr = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
Set srng = .Range("AL1:AP" & lr)
Set drng = SumSh.Range("B" & Rows.Count).End(xlUp)(2)
Set drng = drng.Resize(srng.Rows.Count, srng.Columns.Count)
drng.Value = srng.Value
End With
Next ws
End Sub
I did have to set the target worksheet as that had been left undeclared and unassigned.
I suspect your loop is not picking up the next blank row of the target worksheet because the cells in column B are not merged. In other words, it is overwriting the last row with incoming data because you are asking for the next blank cell in column B and column B always has a blank cell starting the last row.
The last iteration of the loop should be correct; albeit with a blank cell in the last row of column B. Solution: move down an extra row on the target.
I want to find all the cells in Column L with a particular value and return the values in Column D of the same row as those cells found.
So far, I am only able to return one result, which would be the top most result in my list, but I want to find all the rest as well, which I don't know the code to use.
Just to further explain: Value in cell D11 is the value I want to find in Column L of sheet "Master List". Supposedly I find the value in cells L13, L15 and L20, I want to return the value in cell D13, D15 and D20 into cells "C37:C39" of ws. Note: no. of cells that have the value may vary so the values returned will just appear from C37 downwards (something like automatic multiple selection, copy and paste)
Here's a little something to start the ball rolling:
Sub FindRelatedProducts()
Dim cell As Excel.Range
Dim D11Value As Variant
Dim D11Row As Variant
Dim ws As Worksheet: Set ws = Sheets("RShip")
Set cell = ws.Range("D11")
D11Value = cell.Value
With Sheets("Master List")
D11Row = Application.Match(D11Value, .Range("L:L"), 0)
If Not IsError(D11Row) Then
ws.Range("C37") = .Range("D" & D11Row).Value
End If
End With
End Sub
Here's an example using range variables.
You'll want to define a range for the input data range and a range for the output data. Then in the VBA you will want to change the wrk, inRng and outRng variables to be the named ranges you defined and change the column indexes in the for and if blocks to match the column index of the data you are looking for.
Option Explicit
Option Base 1
Sub FindValues()
Dim wrk As Worksheet
Dim inRng As Range
Dim outRng As Range
Dim cntr As Long
Dim outCntr As Long
Dim findVal As Double
Set wrk = Worksheets("Data")
Set inRng = wrk.Range("LookupRange")
Set outRng = wrk.Range("OutputRange")
' Clear the output range in case you have fewer values on this run than on the previous one
outRng.ClearContents
' Set the value you are looking for
findVal = 1
' Iterate through the rows in the input range. If you find the result you want then write it to the output range
For cntr = 1 To inRng.Rows.Count
If inRng(cntr, 1) = findVal Then ' Assumes the value you are finding is in column 1 of the input range
outRng(outCntr, 1) = inRng(cntr, 2) ' Assumes the values you are exporting is in column 2 of the input range
outCntr = outCntr + 1
End If
Next cntr
End Sub
I have written this code, that is part of a bigger problem. Initially it was supposed to start transfer some data from a worksheet to another.. but it keeps skipping rows, it copies one, skips then copies the other one, skips ,copies,skip... I am using the Select method just to test, instead of copy.
Dim sharepointSheet As Worksheet
Dim masterSheet As Worksheet
Dim sharepointTable As Range
'Auxliary variable
Dim row As Range
Dim cell As Range
Dim RowLast As Long
Set sharepointSheet = ThisWorkbook.Worksheets("Sharepoint List")
Set masterSheet = ThisWorkbook.Worksheets("Master List")
Set sharepointTable = masterSheet.Range("A2", "F133")
For Each row In sharepointTable.Rows
row.Cells(row.row, 3).Select
' RowLast = masterSheet.Cells(Rows.Count, "A").End(xlUp).row + 1
' masterSheet.Cells(RowLast, "A").PasteSpecial
Next row
You are having the problem because you are selecting the row relative to you row range rather than the worksheet range.
If you change the select line to the following it will solve your problem:
masterSheet.Cells(row.row, 3).Select
Also not that it's not a good idea to use variables such as row for a range because it can get very confusing!
I have an unsorted list of names in Sheet1, Column A. Many of these names appear more than once in the list.
On Sheet2 Column A I want an alphabetically sorted list of the names with no duplicate values.
What is the optimal method of achieving this using VBA?
Methods I have seen so far include:
Making a collection with CStr(name) as the key, looping through the range and trying to add each name; if there is an error it is not unique, ignore it, else expand the range by 1 cell and add the name
Same as (1), except ignore about the errors. When the loop is complete, only unique values will be in the collection: THEN add the whole collection to the range
Using the match worksheet function on the range: if no match, expand the range by one cell and add the name
Maybe some simulation of the "remove duplicates" button on the data tab? (haven't looked into this)
I really like the dictionary object in VBA. It's not natively available but it's very capable. You need to add a reference to Microsoft Scripting Runtime then you can do something like this:
Dim dic As Dictionary
Set dic = New Dictionary
Dim srcRng As Range
Dim lastRow As Integer
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
lastRow = ws.Cells(1, 1).End(xlDown).Row
Set srcRng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 1))
Dim cell As Range
For Each cell In srcRng
If Not dic.Exists(cell.Value) Then
dic.Add cell.Value, cell.Value 'key, value
End If
Next cell
Set ws = Sheets("Sheet2")
Dim destRow As Integer
destRow = 1
Dim entry As Variant
'the Transpose function is essential otherwise the first key is repeated in the vertically oriented range
ws.Range(ws.Cells(destRow, 1), ws.Cells(dic.Count, 1)) = Application.Transpose(dic.Items)
As you suggested, a dictionary of some sort is the key. I would use a Collection - it is builtin (in contrary to Scripting.Dictionary) and does the job.
If by "optimal" you mean "fast", the second trick is to not access each cell individually. Instead use a buffer. The below code will be fast even with thousands of rows of input.
Code:
' src is the range to scan. It must be a single rectangular range (no multiselect).
' dst gives the offset where to paste. Should be a single cell.
' Pasted values will have shape N rows x 1 column, with unknown N.
' src and dst can be in different Worksheets or Workbooks.
Public Sub unique(src As Range, dst As Range)
Dim cl As Collection
Dim buf_in() As Variant
Dim buf_out() As Variant
Dim val As Variant
Dim i As Long
' It is good practice to catch special cases.
If src.Cells.Count = 1 Then
dst.Value = src.Value ' ...which is not an array for a single cell
Exit Sub
End If
' read all values at once
buf_in = src.Value
Set cl = New Collection
' Skip all already-present or invalid values
On Error Resume Next
For Each val In buf_in
cl.Add val, CStr(val)
Next
On Error GoTo 0
' transfer into output buffer
ReDim buf_out(1 To cl.Count, 1 To 1)
For i = 1 To cl.Count
buf_out(i, 1) = cl(i)
Next
' write all values at once
dst.Resize(cl.Count, 1).Value = buf_out
End Sub