I need all rows returned into a new Sheet if there are matching values in Column G in two different sheets (Q1 DATA, Q2 DATA).
I placed a VLOOKUP formula =VLOOKUP('Q2 DATA'!D:D,'Q1 DATA'!D:D,2) into the 3rd sheet where I want the rows returned to, but I keep getting a #REF! error.
I'm new to Excel so I'm sure my VLOOKUP is broken, but I can't seem to figure it out. Any help would be greatly appreciated!
Assuming your data in Sheet Q1 is structured something as shown in the image below:
and Sheet Q2 is as:
Now, each row value of Column D in Sheet Q2 is to be matched with Column D of Sheet Q1. If match found, copy range E:I from Sheet Q1 to Sheet Q2.
Try this code:
Sub Demo()
Dim data1WS As Worksheet, outputWS As Worksheet
Dim lastRow As Long
Dim myRange As Range, rFound As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set dataWS = ThisWorkbook.Sheets("Sheet Q1")
Set outputWS = ThisWorkbook.Sheets("Sheet Q2")
lastRow = dataWS.Cells(Rows.Count, "D").End(xlUp).row
Set myRange = Range(dataWS.Cells(2, 4), dataWS.Cells(lastRow, 4))
For Each cel In myRange
Set rFound = outputWS.Columns(4).Find(What:=cel.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not rFound Is Nothing Then
Range(outputWS.Cells(cel.row, 5), outputWS.Cells(cel.row, 9)).Value = Range(dataWS.Cells(cel.row, 5), dataWS.Cells(cel.row, 9)).Value
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
This will give output in Sheet Q2 as:
Related
I am working on one scenario where I have two sheets. Sheet1 is the master sheet and sheet2 which I am creating.
Column1 of Sheet1 is Object which has duplicate objects as well. So, what I have done is I have created a macro which will produce the unique Objects and will paste it in sheet2.
Now, from Sheet2, each of the objects should be matched with Sheet1 column1 and based on the matching results, it should also count the corresponding entries from other columns in sheet1 to sheet2.
Below are the snapshots of my two sheets
Sheet1
Sheet2
here is my macro code which will first copy and paste the unique objects from sheet1 to sheet2 Column1.
Sub UniqueObj()
Dim Sh1 As Worksheet
Dim Rng As Range
Dim Sh2 As Worksheet
Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1:A" & Sh1.Range("A65536").End(xlUp).Row)
Set Sh2 = Worksheets("Sheet1")
Rng.Cells(1, 1).Copy Sh2.Cells(1, 1)
Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sh2.Range("A1"), Unique:=True
End Sub
But, I am unable to move forward from there. I am pretty new and any help would be very greatful.
Thanks
If I'm understanding what you want correctly, you're just counting matching columns from Sheet1 where the value in the corresponding column isn't blank? If so this should do the trick.
Option Explicit
Sub GetStuffFromSheet1()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastRow1 As Long, lastRow2 As Long
Dim x As Long
'turn on error handling
On Error GoTo error_handler
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
'determine last row with data in sheet 1
lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
'determine last row with data in sheet 2
lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
'define columns in sheet 1
Const objCol1 As Long = 1
Const rProdCol1 As Long = 3
Const keysCol1 As Long = 4
Const addKeysCol1 As Long = 5
'define columns in sheet 2
Const objCol2 As Long = 1
Const rProdCol2 As Long = 2
Const keysCol2 As Long = 3
Const addKeysCol2 As Long = 4
'turn off screen updating + calculation for speed
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'loop through all rows of sheet 2
For x = 2 To lastRow2
'formula counts # of cells with matching obj where value isn't blank
ws2.Cells(x, rProdCol2) = WorksheetFunction.CountIfs(ws1.Columns(objCol1), ws2.Cells(x, objCol2), ws1.Columns(rProdCol1), "<>" & "")
ws2.Cells(x, keysCol2) = WorksheetFunction.CountIfs(ws1.Columns(objCol1), ws2.Cells(x, objCol2), ws1.Columns(keysCol1), "<>" & "")
ws2.Cells(x, addKeysCol2) = WorksheetFunction.CountIfs(ws1.Columns(objCol1), ws2.Cells(x, objCol2), ws1.Columns(addKeysCol1), "<>" & "")
Next x
'turn screen updating + calculation back on
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
error_handler:
'display error message
MsgBox "Error # " & Err.Number & " - " & Err.Description, vbCritical, "Error"
'turn screen updating + calculation back on
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
End Sub
In case a non VBA solution works for you, you can resume your data with a Pivot Table, take field Object into rows section and rest of fields into values section (choose Count)
This returns the exact output you are looking for. Easy to update and easy to create.
In case you want a VBA solution, because your design is tabular and you are counting values, you can use CONSOLIDATE:
Consolidate data in multiple worksheets
'change K1 with cell where to paste data.
Range("K1").Consolidate Range("A1").CurrentRegion.Address(True, True, xlR1C1, True), xlCount, True, True, False
'we delete column relation type and column value. This columns depends on where you paste data, in this case, K1
Range("L:L,P:P").Delete Shift:=xlToLeft
After executing code i get this:
Hope this helps
I am brand new to VBA coding and am confused on how I would be able to copy and paste values from one sheet to another if two criteria points are met. In the sheet below I want to copy "12, 9, and 15" and paste it into the "Expected, P10 and P90" cells on sheet2 if the names on sheet one "Orange, Green" match those on sheet 1.
I've been attempting this on my own for quite some time now with now luck.
Attached is the code I started
Sub Copy_Certain_Data()
a = Worksheets("Schedule Results").Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To a
If Worksheets("Schedule Results").Cells(i, 3).Value = "NE2P1" Then
Worksheets("schedule results").Rows(i).Copy
Worksheets("Campaign 1 Data").Activate
Range("F2").Select
ActiveSheet.Paste
Worksheets("Schedule Results").Activate
End If
Next
Application.CutCopyMode = False
End Sub
Below is a basic macro to loop through two worksheets and find the row that has matching values in columns A and B. Then writing the values from the row in sheet 1, columns C:E to the row in sheet 2, columns D:F.
Dim ws1 As Worksheet, ws2 As Worksheet
Dim xCel As Range, yCel As Range
Set ws1 = ThisWorkbook.Sheets("Sheet1") 'change sheet names as needed
Set ws2 = ThisWorkbook.Sheets("Sheet2")
For Each xCel In ws1.Range("A2", ws1.Range("A" & ws1.Rows.Count).End(xlUp)) 'loop sheet1 column A
If xCel.Value = "Orange" And xCel.Offset(, 1).Value = "Green" Then 'when both values are found in row goto sheet2 loop
For Each yCel In ws2.Range("A2", ws2.Range("A" & ws2.Rows.Count).End(xlUp)) 'Loop sheet2 Column A
If yCel.Value = "Orange" And yCel.Offset(, 1).Value = "Green" Then 'when found write values from sheet1 to sheet2
yCel.Offset(, 3).Resize(, 3).Value = xCel.Offset(, 2).Resize(, 3).Value
End If
Next yCel
End If
Next xCel
This should give you a start to get you what you are trying to accomplished based on the code you have tried. Its always best practice to set your variables and also qualify worksheets.
Using .copy and .paste can cause issues because if the cells are not the same size you will get an error stating such and that is why I always set the destination cell value = the source cell value.
Option Explict
Sub Copy_Certain_Data()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Sheets("Schedule Results")
Set wsDest = wb.Sheets("Campaign 1 Data")
Dim LastRow As Long, i As Long
LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
For i = 3 To LastRow
If wsSource.Cells(i, 3).Value = "NE2P1" Then
wsDest.Cells(i, 6) = wsSource.Cells(i, 3)
End If
Next i
End Sub
Hoping you can help, please!
So I have 2 worksheets, 1 & 2. Sheet1 has already existing data, Sheet2 is used to dump raw data into. This is updated daily, and the data dump includes both data from previous days, as well as new data. The new data may include rows relating to interactions that may have happened earlier in the month, not just the previous day. So the data is not "date sequential".
There are 9 columns of data, with a unique identifier in column I.
What I'm needing to happen is when running the macro, it looks in column I in Sheet1 and Sheet2, and only copies and pastes rows where the unique identifier in Sheet 2 doesn't already exist in Sheet1. And pastes them from the last empty row onwards in Sheet1.
What I currently have is this - it's all I could find online:
Sub CopyData()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
Dim foundVal As Range
For Each rng In Sheets("Sheet2").Range("A1:I" & LastRow)
Set foundVal = Sheets("Sheet1").Range("I:I").Find(rng, LookIn:=xlValues, LookAt:=xlWhole)
If foundVal Is Nothing Then
rng.EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next rng
Application.ScreenUpdating = True
End Sub
But it's just not working - not only does it not recognise if the value in column I already exists, it's copying and pasting only the first 2 rows from Sheet2, but duplicating them 8 times each!
Apologies in advance, I'm a real VBA novice, and just can't work out where it's all going wrong. I would appreciate any assistance!
This will do what you want:
Sub testy()
Dim wks As Worksheet, base As Worksheet
Dim n As Long, i As Long, m As Long
Dim rng As Range
Set wks = ThisWorkbook.Worksheets(2) 'Change "2" with your input sheet name
Set base = ThisWorkbook.Worksheets(1) 'Change "1" with your output sheet name
n = base.Cells(base.Rows.Count, "A").End(xlUp).Row
m = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
For i = 2 To m
On Error Resume Next
If IsError(WorksheetFunction.Match(wks.Cells(i, 9), base.Range("I:I"), 0)) Then
Set rng = wks.Cells(i, 1).Resize(1, 9) 'Change 9 with your input range column count
n = n + 1
base.Cells(n, 1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
Next i
End Sub
I need to copy data from one worksheet into another. However, I need a conditional copy operation that will skip rows based on criteria.
For example, if I start with...
Active Value
yes 1
no 2
no 3
yes 4
no 5
no 6
I only want to copy rows that are Active=yes, so I would end up with...
Value
1
4
Can someone show me how this is done with 1) a macro and 2) a formula?
Formula approach:
suppose your data are in sheet1, range A2:B7.
Then use this formula in sheet2 cell A2:
=IFERROR(INDEX(Sheet1!B:B,SMALL(IF(Sheet1!$A$2:$A$7="yes",ROW(Sheet1!$A$2:$A$7)),ROW()-ROW($A$2)+1)),"")
with array entry (CTRL+SHIFT+ENTER) and then drag it down.
VBA approach:
You can use AutoFilter:
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, rngToCopy As Range
Dim lastrow As Long
'change Sheet1 and Sheet2 to suit
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
With ws1
'assumung that your data stored in column A:B, Sheet1
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A1:B" & lastrow)
'clear all filters
.AutoFilterMode = False
With rng
'apply filter
.AutoFilter Field:=1, Criteria1:="yes"
On Error Resume Next
'get only visible rows
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
'copy range
If Not rngToCopy Is Nothing Then rngToCopy.Copy Destination:=ws2.Range("A1")
'clear all filters
.AutoFilterMode = False
End With
Application.CutCopyMode = False
End Sub
Note, if you want to copy only Value column, change
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
to
Set rngToCopy = .Offset(, 1).Resize(, .Columns.Count - 1).SpecialCells(xlCellTypeVisible)
It's easy enough with a macro. Assuming you're copying from the first sheet to the second sheet, and that your sample above is in columns A and B, you could do the following:
Public Sub ConditionalCopy()
Dim copyRng As Range
Set copyRng = Worksheets(1).Range("B2:B7")
Dim pasteRng As Range
Set pasteRng = Worksheets(2).Range("A2")
Dim i As Long
i = 0
For Each cell in copyRng.Cells
If cell.Offset(0, -1).Value2 = "yes" Then
pasteRng.Offset(i,0).Value2 = cell.Value2
i = i + 1
End If
Next cell
End Sub
Doing it with a formula presents a challenge in terms of not leaving any blank rows on the second sheet. It would be pretty trivial to just use the following in the second sheet:
=If(A2 = "yes",b2,"")
And copy that down, but you're going to end up with blank rows that you'll have to go back and delete yourself. If you have the ability to use the macro, it's straightforward enough that I would go that route rather than sinking too much effort into devising a formula. The more I think about it, the more I feel like it has to be a programmatic solution to avoid double references.
If you use seperate counters for the source and destination rows, and use cell references rather than ranges the following routine should do the trick
Public Sub copyactivevalue()
Dim i As Integer
Dim j As Integer
Dim acts As Excel.Worksheet
Dim news As Excel.Worksheet
Set acts = Excel.Worksheets("sheet1")
Set news = Excel.Worksheets("sheet2")
With acts
j = 2
For i = 2 To 7
If acts.Cells(i, 1).Value = "yes" Then
news.Cells(j, 1) = acts.Cells(i, 2).Value
j = j + 1
End If
Next
End With
Set acts = Nothing
Set news = Nothing
End Sub
Hope this helps
Basically I need to compare order number and if it matches on the outstanding sheet, add it to sheet 1.
For example.
sheet 1 contains:
OR1545
OR1687
OR898
OR0142
The outstanding sheet contains.
OR898 6684D8D
OR0142 6544D
OR0142 8489DD
OR0142 897EEA
So the sheet1 will check the outstanding sheet and add the items to the OR column.
If there are more then 1 item to goes to the next column.
So the final output on sheet 1 would be:
OR0142 615 6544D 897EEA
OR898 645DD 6684D8D
Here is using the formula:
=IFERROR(TRANSPOSE(INDEX(Sheet2!$B$1:$B$5,SMALL(IF(Sheet2!$A$1:$A$5=$A2,ROW(Sheet2!$A$1:$A$5)),COLUMN(A$1)))),"")
Above is an Array Formula entered using Ctrl+Shft+Enter in Cell C2 and copied to the remaining cells of interest.
Assuming your data is organized like below:
Sheet1:
Outstanding sheet:
Here is the code:
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim myfilters
Dim myfilter
Dim rng1 As Range, rng2 As Range
Set ws1 = Sheet3
Set ws2 = Sheet2
Application.ScreenUpdating = False
With ws1
Set rng1 = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
myfilters = rng1.Offset(1, 0).Resize(rng1.Rows.Count - 1)
End With
With ws2
.AutoFilterMode = False
Set rng2 = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
For Each myfilter In myfilters
rng2.AutoFilter Field:=1, Criteria1:=myfilter
rng2.Offset(1, 1).SpecialCells(xlCellTypeVisible).Copy
rng1.Find(myfilter, rng1(1)).Offset(0, 2).PasteSpecial xlPasteValuesAndNumberFormats, , , True
.AutoFilterMode = False
Next
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Not tested though.
So test it in a duplicate data for safety.
Hope this helps.