I need to set a range to select only the cells in a row which contain data.
Sometimes there will be data in columns B, C, D, E and F of row 3, whilst at other times there will be data in the first 10 or 20 columns of that row.
I've tried the below, but it doesn't work.
Dim rRng As Range
Set rRng = Sheets(1).Range("B3").End(xltoright)
I know that I'm wide of the mark, but am struggling with this.
This code will be run for a variety of different datasets; sometimes it needs to select five cells, sometimes ten (if populated).
Select to the last column or select non blanks
Sub SelectLstCol()
Dim Col As Long
Dim rng As Range
Col = Cells(3, Columns.Count).End(xlToLeft).Column
Set rng = Range(Cells(3, 2), Cells(3, Col))
rng.Select 'or whatever you want to do with it
End Sub
Sub NonBlanks()
Dim Col As Long
Dim rng As Range
Col = Cells(3, Columns.Count).End(xlToLeft).Column
Set rng = Range(Cells(3, 2), Cells(3, Col)).SpecialCells(xlCellTypeConstants, 23)
rng.Select 'or whatever you want to do with it
End Sub
Using a function to be able to reuse it more easily :
Sub test_andrew_abbott()
MsgBox Get_Row_Range(5).Address
MsgBox Get_Row_Range(Range("A12").Row).Address
End Sub
This will be more robust than with .End(xlToRight) :
Public Function Get_Row_Range(RowNumber As Long) As Range
Dim wS As Worksheet, _
rRng As Range
Set wS = Sheets(1)
With wS
Set rRng = .Range(.Range("A" & RowNumber), _
.Cells(RowNumber, .Columns.Count).End(xlToLeft))
End With
Set Get_Row_Range = rRng
End Function
You can connect to your excel file as a data set, I find it better than other way
Related
I am working with the excel-vba, I have to sort the rows in ascending order with merged cells, I know that the merged cell cannot be sorted that is why, this work around is the only solution to my problem. I need to unmerged the cells then copy the value of the first cell and paste it to the second cell, after that, the code will sort the list using the A column and C column. and then after that if the A and C column has an equal value, it will turn to merged cell.
I hope someone could help me with this project.
Also view this image to see the list.
Sort
So, I constructed a code that will do this process but it cant.
Sub Sort()
On Error GoTo myErr
Dim myRange As Range
Dim lstrow As Long
Dim i As Integer
Dim cel As Range
Set myRange = Sheet1.Range("A2:C7")
lstrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
With myRange
.UnMerge
For Each cel In myRange
If IsEmpty(cel) Then
For i = 2 To lstrow
' cel(i).Value = 1
Sheet1.Range(i).Copy Sheet1.Range(cel).PasteSpecial
Sheet1.Range("C3").CurrentRegion.Sort _
key1:=Sheet1.Range("C3"), order1:=xlAscending, _
Header:=xlGuess
Next i
End If
Next cel
End With
myErr:
MsgBox "Unble to sort!"
End Sub
“No one is useless in this world who lightens the burdens of another. -Charles Dickens”
Regards,
If you are going to find lstRow before unmerging, use Column B — if the last row in Column A is merged, then the bottommost cell is empty! Or if you prefer, you can find lstRow after unmerging everything.
By looping through myRange you can both UnMerge any merged cells and populate the newly unmerged cells using the MergeArea.address of the original merged cell. After sorting on columns A and C, you can then loop through those columns, comparing each row to the row beneath. Only re-merge when both the row beneath is the same as the row above for both columns.
Option Explicit
Sub Sort()
Dim myRange As Range
Dim lstrow As Long
Dim l As Long
Dim rng As Range
Dim address As String
Dim contents As Variant
Dim ws As Worksheet
On Error GoTo myErr
Set ws = ThisWorkbook.Sheets("Sheet1")
Set myRange = ws.Range("A1:C7")
' Get lstrow from Column B, if Column A has merged cells
lstrow = ws.Cells(Rows.Count, 2).End(xlUp).Row
' Unmerge and populate
For Each rng In myRange
If rng.MergeCells Then
' Get value from top left cell
contents = rng.MergeArea.Cells(1).Value
address = rng.MergeArea.address
rng.UnMerge
ws.Range(address).Value = contents
End If
Next rng
' Sort
myRange.Sort key1:=ws.Range("A1:A" & lstrow), _
order1:=xlAscending, Header:=xlYes, key2:=ws.Range("C1:C" & lstrow), _
order2:=xlAscending, Header:=xlYes
' Turn off alerts
Application.DisplayAlerts = False
' Re-merge
With ws
For l = 2 To lstrow
If .Cells(l, 1).MergeArea.Cells(1).Value = .Cells(l + 1, 1).MergeArea.Cells(1).Value _
And .Cells(l, 3).MergeArea.Cells(1).Value = .Cells(l + 1, 3).MergeArea.Cells(1).Value Then
' Merge column A
Range(.Cells(l, 1).MergeArea, .Cells(l + 1, 1)).Merge
' Merge column C
Range(.Cells(l, 3).MergeArea, .Cells(l + 1, 3)).Merge
End If
Next l
End With
' Turn on alerts
Application.DisplayAlerts = True
Exit Sub
myErr:
MsgBox "Unable to sort!"
End Sub
Hi there I am trying to select a range "A2:H2" down to the last filled cell based on column A (so in this case it should select "A2:H59"). The range is not fixed so it cannot be defined with exact numbers. I have the following code, but it selects everything down to the 402nd row even though there is no data beyond "A59" in the sheet. Any idea what is going on? Thanks for the help!
Global ssaw As Worksheet
Global trckr As Worksheet
Sub DataF()
Dim myRange As Range
Dim myCell As Range
Set ssaw = Sheets("SSAW_DATA")
Set trckr = Sheets("SQL_DATA_FEED")
Set myRange = trckr.Range("A2:H2").end(xlDown)
With myRange
.SpecialCells(xlCellTypeBlanks).Interior.Color = RGB(255, 102, 102)
.SpecialCells(xlCellTypeBlanks).Value = "#missing#"
End With
End Sub
If we assume your last used cell in column A is A59 then …
… This
Set myRange = trckr.Range("A2", trckr.Range("A2").End(xlDown))
will select A2:A59 and this
.Resize(ColumnSize:=8)
will resize it to make it 8 columns width that is A2:H59.
So together we get:
Set myRange = trckr.Range("A2", trckr.Range("A2").End(xlDown)).Resize(ColumnSize:=8)
Use this
trckr.Range("A" & trckr.Rows.Count).End(xlUp)
alternatively to find the last used cell in column A if there can be empty cells in between:
Set myRange = trckr.Range("A2", trckr.Range("A" & trckr.Rows.Count).End(xlUp)).Resize(ColumnSize:=8)
exploit the fact that Range(cell1, cell2) is equivalent to Range(cell2, cell1)
Set myRange = trckr.Range("H2", trckr.Range("A2").End(xlDown))
while if you want to select a range from A2:H2 down to column A last not empty cell (i.e. included empty cells along column A in between the first and last not empty ones):
Set myRange = trckr.Range("H2", trckr.Cells(trckr.Rows.Count, 1).End(xlUp))
I would suggest to use the following code
Option Explicit
Function LastRowInColumn(colName As String)
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, colName).End(xlUp).Row
End With
LastRowInColumn = lastRow
End Function
Sub SelectRg()
Dim rg As Range
Dim wks As Worksheet
Dim lastRow As Long
lastRow = LastRowInColumn("A")
Debug.Print lastRow
If lastRow = 1 Then
' do nothing
Else
Set wks = ActiveSheet
With wks
Set rg = Range(.Cells(2, 1), .Cells(lastRow, "H"))
rg.Select
End With
End If
End Sub
The code determins the last filled row in column A and select based on this information everything to column H
EDIT Improved function
Function LastRowInColumn(ByVal wks As Worksheet, ByVal colName As String) As Long
With wks
LastRowInColumn = .Cells(.Rows.Count, colName).End(xlUp).Row
End With
End Function
EDIT2 And if one would not like to use an extra function you could do it like that
Sub SetRg()
Dim rg As Range
Dim wks As Worksheet
Dim lastRow As Long
Set wks = ActiveSheet
With wks
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'lastRow = LastRowInColumn(wks, "A")
If lastRow > 1 Then
Set rg = Range(.Cells(2, 1), .Cells(lastRow, "H"))
End If
End With
End Sub
I am very new to VBA and I am trying to solve a problem to which I can't find the answer to on here.
I have 3 columns of data,
which you can see here:
I want to write a macro with which I can search the first fruit of column D in A. If the macro finds a match I want to copy the property of the fruit (B)(e.g. Vegetable) to E next to the corresponding name.
An example:
D6=Pineapple
search for pineapple in A and then copy B4 (Fruit) to E2.
Then continue with D3 (Avocado) doing the same procedure.
This is what I came up with so far. I know it is terrible and it doesn't work at all :')
Option Explicit
Sub fruits()
Dim fruit As String
Dim i As Integer
i = 1
Do While i < 20
Set fruit = Cells(i, "D").Value
If Not fruit Is Nothing Then
Set Cells(i, "E") = Columns(1).find(fruit.Value).Offset(0, 1).Text
End If
i = i + 1
Loop
End Sub
If you have any advice or solutions I would really appreciate it.
Sorry that I am posting such a 'trivial' question, but I really don't know how to.
Thanks, NiceRice
dim rng as range, rng2 as range, rcell as range, rcell2 as range
set rng = Thisworkbook.sheets("sheetName").range("d1:d3")
set rng2 = Thisworkbook.sheets("sheetName").range("a1:a8")
for each rcell in rng.cells
if rcell.value <> vbNullstring then
for each rcell2 in rn2.cells
If rcell.value = rcell2.value then
rcell.offset(0,1).value = rcell2.value
end if
next rcell2
end if
next rcell
pretty straight forward
I agree with Scott Craner, using Vlookup is the way to go, but I thought I would share a slightly different way to accomplish the same in VBA using the Find method:
Option Explicit
Sub fruits()
Dim LastRow As Long, LastARow As Long
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastDRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
'get the last row with data on Column D
LastARow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Dim rng As Range, c As Range, FoundVal As Range
Set rng = ws.Range("D1:D" & LastDRow)
For Each c In rng
Set FoundVal = ws.Range("A1:A" & LastARow).Find(What:=c.Value)
If Not FoundVal Is Nothing Then
c.Offset(0, 1).Value = FoundVal.Offset(0, 1).Value
End If
Next
End Sub
I am trying to loop through a column and if cells = "what i'm lookng for" then do something.
I have this so far, where I'm off is in the if statement where I check for the "name":
Option Explicit
Sub test()
Dim wksDest As Worksheet
Dim wksSource As Worksheet
Dim rngSource As Range
Dim name As String
Dim LastRow As Long
Dim LastCol As Long
Dim c As Long
Application.ScreenUpdating = False
Set wksSource = Worksheets("Sheet1")
With wksSource
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For c = 16 To 20
LastRow = .Cells(.Rows.Count, c).End(xlUp).Row
Set rngSource = .Range(.Cells(5, 16), .Cells(LastRow, 16))
name = rngSource.Value
If name = "mark"
do something
End If
Next c
End With
Application.ScreenUpdating = True
'MsgBox "Done!", vbExclamation
End Sub
OK Chris
Maybe a bit of simplification is required but also a few assumptions.
It doesn't seem like LastCol is being used for anything - so let's assume this is the Column you want to loop through.
Your loop has fixed start and end values yet you are determining the LastRow - so let's assume you want to start from row 5 (in your code) and loop to the LastRow in the LastCol.
In order to determine LastCol you must have data in the row you are using to do this - so let's assume that there are values in row 1 in all columns up to column you want to loop say 16 (in your code).
If you want to (IF) test for a single (string) value in this case then you must arrange for your rngSource to be a single cell value. You also don't need to assign this to a variable unless you need to use it again.
Finally, if you want to check for other values you may want to consider using a SELECT CASE structure in place of your IF THEN structure.
Have a look at the following and change my assumptions to meet your requirement - good luck.
Sub test()
Dim wksDest As Worksheet
Dim wksSource As Worksheet
Dim rngSource As Range
Dim name As String
Dim LastRow As Long
Dim LastCol As Long
Dim c As Long
Application.ScreenUpdating = False
Set wksSource = Worksheets("Sheet1")
With wksSource
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
LastRow = .Cells(Rows.Count, LastCol).End(xlUp).Row
FirstRow = 5
For c = FirstRow To LastRow
If .Range(.Cells(c, LastCol), .Cells(c, LastCol)).Value = "Mark" Then
MsgBox ("do something")
End If
Next c
End With
End Sub
You can just do that with one line.
If Not IsError(Application.Match(ValueToSearchFor, RangeToSearchIn, 0)) Then
'The value found in the given range
End If
Example:
Search for "Canada" in column C of sheet named "Country"
If Not IsError(Application.Match("Canada", Sheets("Country").Range("C:C"), 0)) Then
'The value found in the given range
End If
Pass value to find and Column where value need to be checked. It will return row num if its found else return 0.
Function checkForValue(FindString As String,ColumnToCheck as String) As Long
SheetLastRow = Sheets("Sheet1").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).row
With Sheets("Sheet1").Range("$" & ColumnToCheck & "$1:$" & ColumnToCheck & "$" & CStr(SheetLastRow) )
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
checkForValue = rng.row 'return row its found
'write code you want.
Else
checkForValue = 0
End If
End With
End Function
I tried Hari's suggestion, but Application.Match works weird on range names (not recognizing them...)
Changed to: WorksheetFunction.Match(...
It works, but when value is not present A runtime ERROR jumps before IsError(...) is evaluated.
So I had to write a simple -no looping- solution:
dim Index as Long
Index = -1
On Error Resume Next
Index = WorksheetFunction.Match(Target,Range("Edificios"), 0) 'look for Target value in range named: Edificios
On Error GoTo 0
If Index > 0 Then
' code for existing value found in Range # Index row
End If
Remeber Excel functions first index = 1 (no zero based)
Hope this helps.
I'm guessing what you really want to do is loop through your range rngSource. So try
Set rngSource = .Range(.Cells(5, 16), .Cells(LastRow, 16))
for myCell in rngSource
if myCell.Value = "mark" then
do something
end if
next myCell
I am writing a code in Excel for a 3 sheets, sheet 1 will display the data that does not appear in Sheet2 from Sheet3, in order to acomplish this the code will be the following;
Dim r As Excel.Range
Dim cell As Excel.Range
Set r = Sheet3.Range(Sheet3.Cells(1, 1), Sheet3.Cells(Rows.Count, 1).End(xlUp))
Dim curRowSheet1 As Long
curRowSheet1 = 1
For Each cell In r
Set rFind = Sheet2.Range("A:A").Find(cell.Value)
If (rFind Is Nothing) Then
cell.EntireRow.Copy Sheet1.Cells(curRowSheet1, 1)
curRowSheet1 = curRowSheet1 + 1
End If
Next cell
NOTE: I am trying to include a second .FIND under line 9 "SET rFind" where if looks for the cell values in column ("A:Ä") and then it also verifies the values are the same from column ("B:B") from both sheets 2 and 3, I am thinking I can use the Offset() function to compare this data, any advise on this would be appreciated!!!!
Thanks.
Instead of Range.Find, I would recommend using WorksheetFunction.CountIfs
Sub tgr()
Dim ACell As Range
For Each ACell In Sheet3.Range("A1", Sheet3.Cells(Rows.Count, "A").End(xlUp)).Cells
If WorksheetFunction.CountIfs(Sheet2.Columns("A"), ACell.Value, Sheet2.Columns("B"), ACell.Offset(, 1).Value) = 0 Then
ACell.EntireRow.Copy Sheet1.Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next ACell
End Sub