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
Related
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 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
I'm writing a macro in Excel 2010 for a problem that is as follows:
I have two columns, one with a Key string value and one with a uuid. The idea is that every key should have only one uuid but as the table is now, key cell could be merged cells or single cells.
The macro needs to recognize which cells are merged and which are not, so, I have two options:
If cell is merged, check all its adjacent cells, pick first uuid value and copy/paste it to other adjacent cells, that is to say, cell below(Could be with an Offset())
If cell is not merged , but key value is repeated in multiple cells, copy/paste uuid value to adjacent cells.
So basically is to check merged cells MergeArea but I don't know if I need to iterate through its addresses or check cells in the range with an offset of Offset(0,1) or what.
With my code I can know if the cells are merged but now, how con I iterate through it's adjacent cells values?
Code as is now:
Sub CopyUUID()
Dim lRow As Long
Dim rng As Range
Dim ws As Worksheet
Dim rMerged As Range
Dim value As Variant
Set ws = Sheets(ActiveSheet.Name)
On Error GoTo ExitProgram 'If an error happens within the execution, skips it and continue in next step
Application.DisplayAlerts = False 'We can cancel the procedure without errors
With ws
lRow = .Range("F" & .Rows.count).End(xlUp).row
Set rng = .Range(.Cells(3, 6), .Cells(lRow, 6))
rng.Select
For Each cell In rng
If cell.MergeCells Then
'Code for merged cells
Else
'Code to use for single cells
End If
Next cell
End With
ExitProgram:
Exit Sub
End Sub
Option Explicit
Sub CopyUUID()
Const UUID As Long = 31 'col AE
Dim lRow As Long, cel As Range, isM As Boolean, copyID As Boolean, kCol As Long
With ActiveSheet
kCol = -25 'col F
lRow = .Cells(.Rows.Count, UUID + kCol).End(xlUp).Row
For Each cel In .Range(.Cells(3, UUID), .Cells(lRow, UUID))
isM = cel.Offset(0, kCol).MergeCells
copyID = isM And Len(cel.Offset(0, kCol)) = 0
copyID = copyID Or (Not isM And cel.Offset(0, kCol) = cel.Offset(-1, kCol))
If copyID Then cel = cel.Offset(-1)
Next
End With
End Sub
Try the following code. Note that this is going to overwrite the current contents of UUID, so make a backup copy before testing. If you don't want the UUID column modified, you can modify this to suit your needs.
Sub CopyUUID()
Dim lRow As Long
Dim rng As Range
Dim c As Range
Dim ws As Worksheet
Dim rMerged As Range
Dim value As Variant
Set ws = Sheets(ActiveSheet.Name)
On Error GoTo ExitProgram 'If an error happens within the execution, skips it and continue in next step
' Application.DisplayAlerts = False 'We can cancel the procedure without errors
With ws
lRow = .Range("F" & .Rows.Count).End(xlUp).Row
Set rng = .Range(.Cells(3, 6), .Cells(lRow, 6))
' rng.Select
For Each c In rng
If c.MergeCells Then
'Code for merged cells
c.Offset(0, 1).Formula = c.MergeArea.Cells(1, 1).Offset(0, 1).Formula
Else
'Code to use for single cells
If c.Formula = c.Offset(-1, 0).Formula Then
c.Offset(0, 1).Formula = c.Offset(-1, 1).Formula
End If
End If
Next c
End With
ExitProgram:
Exit Sub
End Sub
When in a MergedCell, it makes the UUID the same as the UUID of the first cell in the merged area. When not in a MergedCell, it copies UUID from the row above if Key is the same as the row above.
I changed your variable cell to c (I don't like to use variable names that can be confused with built-ins) and commented out a couple of lines.
Hope this helps
I adopt a simple approach to this problem as illustrated through steps taken by me.
sample sheet showing data with merged cells and unmerged cells.
Run the program code to unmerge the cells. Output of the program is appended below.
If this structure of data matches your case then addition of 2 lines of code for column B will leave the data as per following image.
Program code is as follows:
'Without column deletion:
Sub UnMergeRanges()
Dim cl As Range
Dim rMerged As Range
Dim v As Variant
For Each cl In ActiveSheet.UsedRange
If cl.MergeCells Then
Set rMerged = cl.MergeArea
v = rMerged.Cells(1, 1)
rMerged.MergeCells = False
rMerged = v
End If
Next
End Sub
'With coumn deletion
Sub UnMergeRangesB()
Dim cl As Range
Dim rMerged As Range
Dim v As Variant
For Each cl In ActiveSheet.UsedRange
If cl.MergeCells Then
Set rMerged = cl.MergeArea
v = rMerged.Cells(1, 1)
rMerged.MergeCells = False
rMerged = v
End If
Next
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
End Sub
I have one file with two worksheets, both are full of names and addresses. I need a macro that will highlight rows in the first sheet if the cell A of that row does not match any rows from column A of the second sheet.
So if the first cell in a row has no matching data in any of the data in column A of sheet2 then that row is highlighted red.
Also I might want to expand this in the future so could I also specify that Sheet1 can be the active sheet, but sheet2 is called by the sheet name?
Try below code :
Sub Sample()
Dim lastRow As Integer
Dim rng As Range
lastRow = Sheets("Sheet1").Range("A65000").End(xlUp).Row
For i = 1 To lastRow
Set rng = Sheets("sheet2").Range("A:A").Find(Sheets("Sheet1").Cells(i, 1))
If rng Is Nothing Then
Sheets("Sheet1").Cells(i, 1).EntireRow.Interior.Color = vbRed
End If
Next
End Sub
Here's an ugly brute-force approach:
Dim r As Range
Dim s As Range
For Each r In ActiveSheet.UsedRange.Rows
For Each s In Sheets("Sheet2").UsedRange.Rows
If r.Cells(1, 1).Value = s.Cells(1, 1).Value Then
r.Interior.ColorIndex = 3
End If
Next s
Next r
Here's a slicker way:
Dim r As Range
Dim s As Range
Set s = Sheets("Sheet2").Columns(1)
For Each r In ActiveSheet.UsedRange.Rows
If Not (s.Find(r.Cells(1, 1).Value) Is Nothing) Then
r.Interior.ColorIndex = 3
End If
Next r
how about this:
Sub CondFormatting()
Range("D1:D" & Range("A1").End(xlDown).Row).Formula = "=IF(ISERROR(VLOOKUP(A:A,Sheet2!A:A,1,FALSE)),""NOT FOUND"",VLOOKUP(A:A,Sheet2!A:A,1,FALSE))"
With Columns("D:D")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""NOT FOUND"""
.FormatConditions(1).Interior.ColorIndex = 3
End With
Range("I16").Select
End Sub
here is an approach using a Worksheet formula:
=IF(ISERROR(VLOOKUP(A:A,Sheet2!A:A,1,FALSE)),"NOT FOUND",VLOOKUP(A:A,Sheet2!A:A,1,FALSE))
then you would use Conditional formatting to turn the cells red if column A doesn't find a match!
HTH
Philip