This is the scenario:
two worksheets - Sheet1 & Sheet2
Sheet1 has everything Sheet2 has and more
I am looking to find an exact match in Sheet1 Column A and B to data in Sheet2 Columns A and B (row location will always be different than Sheet1) and then copy the contents of column C from sheet 1 to the appropriate row in Sheet2 column C.
I have tried multiple Match statements. I am getting all kinds of errors and cannot even get an incorrect result.
Sheet1 is the primary table. Sheet2 is a subset of data from Sheet1 (the results of a pivot table drill-down. The idea is to look at each row, columns A & B in Sheet2 and find a match in Cols A & B of Sheet1. Then copy the value from the same row in column C to the corresponding row in Sheet2.
This was one attempt:
Sub match_1()
Sheets("Sheet2").Range("A2:B2").Value = WorksheetFunction.Match( _
Sheets("Sheet1").Range("A2").Value, _
Sheets("Sheet1").Range("A:B"), _
0)
End Sub
Sheet1:
Sheet2:
There are three problems with how you are using the Match function:
Match expects a single row or column of data in the second argument. You have passed it 2 columns, so it will always return a #N/A error
Match returns the item number within the Row/Column which matches the first argument. You then need to use Index or Range or Cell to get the value.
Match does not match multiple columns. I explain here how to do this match without VBA
Using my example from Point 3, here is some code to achieve your aim:
Sub matchValues()
Dim calculation As XlCalculation, screenUpdating As Boolean
calculation = Application.calculation: Application.calculation = xlCalculationManual
screenUpdating = Application.screenUpdating: Application.screenUpdating = False
Dim rCaseLink As Range
With Worksheets("Sheet2")
Set rCaseLink = .Range(.Cells(2, 3), .Cells(.Rows.Count, 2).End(xlUp).Offset(0, 1))
End With
With rCaseLink
'This formula will pull back the Value for Column C based on A and B
.Formula = "=INDEX(Sheet1!$C$2:$C$999, AGGREGATE(15, 6, ROW(Sheet1!$A$2:$A$999)/(--(Sheet1!$A$2:$A$999=$A2)*--(Sheet1!$B$2:$B$999=$B2)), 1)-1, 1)"
.Calculate
.Value = .Value 'This will flatten the value, so that it is no longer a formula
End With
'Reset Excel
Application.calculation = calculation
Application.screenUpdating = screenUpdating
End Sub
Related
Consider the following table:
I have a series of blank cells with missing data. From this missing data I only have the year in the next column. I need to fill any blank cells with a standard day/month of 30/06. The year of each cell however needs to be the year in the next column. The attached file shows how my data is arranged. So at cell B 2091, the date shall be 30/06/2011 while for cell B 2098 the date shall be 30/06/2018 and at cell B 2100 the date shall be 30/06/2008.
Filter on the blank cells in column B. Then, in the topmost cell (which I'll assume to be B1 but will likely be different), enter a formula similar to the following and fill down
=DATE(C1,6,30)
where the row number in C1 is the same as your first row of data.
You can achieve this with a helper column (any blank column in the same worksheet where you need the dates). In that column enter this formula in the first cell (here in row 2) and copy down.
=IF(ISBLANK(B2),DATE(C2,6,30),B2)
Then copy the Values from the helper column to the date column and delete the helper.
Below is a small macro that is doing the same job. It needs no helper column and over-writes your existing blanks. Before you run it make sure to check the values of the 2 constants at the top and the name of the worksheet (especially the latter!) against your requirements.
Sub WriteStandardDate()
'293
Const FirstDataRow As Long = 2 'change to suit
Const DateClm As Long = 2 'change to suit
' year column must be adjacent to DateClm
Dim R As Long
Dim Arr As Variant
Dim Rng As Range
With Worksheets("Sheet1") ' change name as required
Set Rng = .Range(.Cells(FirstDataRow, DateClm), _
.Cells(.Rows.Count, DateClm).End(xlUp)) _
.Resize(, 2)
Arr = Rng.Value
For R = 1 To UBound(Arr)
If IsEmpty(Arr(R, 1)) Then
Arr(R, 1) = DateSerial(Arr(R, 2), 6, 30)
End If
Next R
Rng.Value = Arr
End With
End Sub
Update: I used the formula suggested by Variatus: =IF(ISBLANK(B2),DATE(C2,6,30),B2) and worked fine through a helper column. There was no need to copy / paste the new dates into the Dates column. I just used the helper column as the new Dates column since full dates from the original column were not changed and got inserted in the helper column thanks to the IFBLANK portion of the formula. Thanks.
I am trying to build an interactive worksheet that tracks the status of various funders at a nonprofit. I need to build a macro that copies the value of column A to a different sheet if the value of column E in the same row = "funded"
at present, I can copy the entire row, but I only need the value of column A
This is the code that I am using on a similar macro, but for a different sheet.
Option Compare Text
Sub copyToSheet()
Dim Cell As Range
With Sheets(1)
For Each Cell In .Range("E1:E" & .Cells(.rows.Count, "E").End(xlUp).row)
If Cell.Value = "Upcoming" Then
.rows(Cell.row).Copy Destination:=Sheets(2).rows(Cell.row)
End If
Next Cell
End With
Call deleteEmpties
End Sub
This works well when I need the whole row copied to another sheet, but now I need to copy only the values of certain columns to a new sheet while still testing against the value in column E
For example:
If Cell.Value = "Upcoming" Then
Cell.entirerow.columns("A").Copy Destination:=Sheets(2).Cells(Cell.row, "A")
End If
I have data in excel file for which filter has to be applied for each column independently but the filter condition is same. The reason for asking this is each column has that cell that meets the condition in a different row number.In table 1 I have 3 columns a,b and c.
I want to filter each columns independently with value=20 so that the result looks like table below
Try out this VBA code,
Sub matchvalues()
Dim i As Long, j As Long
Sheets.Add.Name = "newSheet"
j = InputBox("Enter the value to filter")
Rows("1:1").Copy Sheets("newSheet").Cells(1, 1)
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If IsError(Application.Match(j, Columns(i), 0)) Then
Sheets("newSheet").Cells(2, i) = ""
Else
Sheets("newSheet").Cells(2, i) = j
End If
Next i
End Sub
This code will prompt the value that has to be filtered. Need to give that as input which will create a new sheet and output the values if present.
If you want to do this with just formulas, try the below. If the value that you are searching is in cell E1, enter the below formula in cell G2 and drag across.
=IF(ISNUMBER(MATCH($E$1,A:A,0)),$E$1,"")
You can change the values in E1 directly to see the updated result. Hope this helps.
I have three columns, A, B and C:
Column A contains names, NAME1, NAME2, etc.
Column B contains only the values "YES" or "NO".
Column C is suppose to contain the names from column A that have value "YES" in column B.
I can say that as long as the value is "YES" in column B, copy the value from column A to column C. Very simple with:
C1=IF(B1="YES",A1,"")
But this will include blank cells, which I don't want to. So I guess I am looking for a way to copy all the names from column A with value "YES" in column B and paste them into column C skipping the blanks.
I did find a VBA project that colors all the cells within a column with a certain value. I am not sure how to edit this into what I need. Here is the code I came up with so far.
ISSUES
1) Runtime Error '1004' Application-defined or Object-defined error
2) Copying from Column A
3) Check and Remove Duplicates from NewRange
EDIT 1: Added comment rows into the code
EDIT 2: Change NewRange to be made from column A with Offset (untested due to runtime error)
EDIT 3: Code for copying form one sheet separated from code for pasting into another sheet
EDIT 4: Added correction from user #abahgat
EDIT 5: Remove duplicates
Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1
'--> Loop through each cell in column B
'--> Add each cell in column A with value "YES" in column B to NewRange
For Each cell In Worksheets("Sheet1").Range("B1:B30")
If cell.Value = "YES" Then
If MyCount = 1 Then Set NewRange = cell.Offset(0,-1)
Set NewRange = Application.Union(NewRange, cell.Offset(0,-1))
MyCount = MyCount + 1
End If
Next cell
'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=activesheet.Range("C1")
'--> Remove Duplicates
activesheet.Range("C1:C30").RemoveDuplicates
End Sub
Solution without VBA:
column C contains formulas like:
=COUNTIF(B$1:B1;"yes")
increase number in column C if this row has "yes" value in column B.
This value will by used in next step.
column D contains formulas like:
=INDEX(A:A;MATCH(ROW();C:C;0))
take value from:
table: an entire A row
row number: calculated by match function: find first occurance of row number (row number where we will place the value) in entire C column. 0 meens that we looking for exactly this number not an clossest.
to skip errors:
=IF(ISERROR(MATCH(ROW();C:C;0));"";INDEX(A:A;MATCH(ROW();C:C;0)))
easier can be writen:
=IFERROR(INDEX(A:A;MATCH(ROW();C:C;0));"")
and this means:
write the value from rule if this value is not an error or write empty string if the rule is an error
Just used a Andcondition on your If to avoid the empty cells
In C1, put then copy down =IF(AND(LEN(A1>0),B1="YES"),A1,NA()))
Select column C
Press F5
Special ... check Formulas and then tick Errors (see pic)
Delete the selected cells, to leave you with a shorter list of desired names in column C
This will do the trick:
Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1
For Each cell In Worksheets("Sheet1").Range("B1:B30")
If cell.Value = "YES" Then
If MyCount = 1 Then Set NewRange = cell.Offset(0,-1)
Set NewRange = Application.Union(NewRange, cell.Offset(0,-1))
MyCount = MyCount + 1
End If
Next cell
NewRange.Copy Destination:=activesheet.Range("D1")
End Sub
Trying to run a macro in Excel to remove non dupes so dupes can be examined easily.
Step through each cell in column "B", starting at B2 (B1 is header)
During run, if current cell B has a match anywhere in column B - leave it, if it' unique - remove entire row
The code below is executing with inconsistent results.
Looking for some insight
Sub RemoveNonDupes()
Selection.Copy
Range("B2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("B2:B5000").AdvancedFilter Action:= xlFilterInPlace, CriteriaRange:= Range("B2"), Unique := True
Range("B2:B5000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.showalldata
End Sub
Not the most direct route, but you could have the macro insert between B and C. Then dump a formula in that column that counts.
Something like =countifs(B:B,B:B) That will give you a count of how many times a record shows, then you can set the script to Loop deleting any row where that value is 1.
Something like
Sub Duplicates()
Columns("B:B").Insert Shift:=xlToRight ' inserts a column after b
count = Sheet1.Range("B:B").Cells.SpecialCells(xlCellTypeConstants).count ' counts how many records you have
crange = "C1:C" & count ' this defines the range your formula's go in if your data doesn't start in b1, change the c1 above to match the row your data starts
Sheet1.Range(crange).Formula = "=countifs(B:B,B:B)" ' This applies the same forumla to the range
ct=0
ct2=0 'This section will go cell by cell and delete the entire row if the count value is 1
Do While ct2 < Sheet1.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count
For ct = 0 To Sheet1.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count
If Sheet1.Range("C1").Offset(ct, 0).Value > 1 Then
Sheet1.Range("C1").Offset(ct, 0).EntireRow.Delete
End If
Next
ct2 = ct2 + 1
Loop
Sheet1.Columns("B:B").EntireColumn.delete
end sub
Code isn't pretty, but it should do the job.
**Updated code per comments
Sub Duplicates()
Columns("C:C").Insert Shift:=xlToRight ' inserts a column after b
count = Activesheet.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count ' counts how many records you have
crange = "C1:C" & count ' this defines the range your formula's go in if your data doesn't start in b1, change the c1 above to match the row your data starts
Activesheet.Range(crange).Formula = "=countifs(B:B,B:B)" ' This applies the same forumla to the range
ct=0
ct2=0 'This section will go cell by cell and delete the entire row if the count value is 1
'''''
Do While ct2 < Activesheet.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count
For ct = 0 To Activesheet.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count
If Activesheet.Range("C1").Offset(ct, 0).Value = 1 Then
Activesheet.Range("C1").Offset(ct, 0).EntireRow.Delete
End If
Next
ct2 = ct2 + 1
Loop
ActiveSheet.Columns("C:C").EntireColumn.delete
end sub
You can try that updated code, the part with the Do Loop is what will delete each column, I fixed it to delete any row where the count is 1.
Based on what I understand, your data should be in column B and the counts should be in column C. If that isn't correct, update the formula's to match
Chris, to examine the unique values in a given range of data, I suggest utilizing Excel's Advanced Copy function in a slightly different way:
Range("RangeWithDupes").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("TargetRange"), unique:=True
The operation will provide you a list of unique values from 'RangeWithDupes' located at 'TargetRange'. You can then use the resultant range to manipulate the source data in many ways. Hope this helps.