VBA to identify matches in multiple columns and return values from matching rows in a different column, to another worksheet.

[cjctmo]

Hello. I am a beginner and I need a VBA code to check some columns for a particular value and return values located in another column of the rows that match. Multiple columns need to be checked but the returns values will be from one particular column. I thought about doing this with excel formulas in cells but isn't efficient.
In the example below, worksheet 1 has the source data to be checked and the output will be on worksheet 2.
In worksheet 1, I want to check column C for "Y" and if there is a match, copy columns A values for matching rows to worksheet 2 column A. Check for "Y" in column H and copy values from column A to worksheet 2 column H. There will be additional columns to check for "Y" at fixed column intervals in worksheet 1 that will be copied to fixed column intervals in worksheet 2 until there are no more columns to check. I hope this isn't too confusing. I thank you in advance.

	Worksheet 1
	A	B	C	D	E	F	G	H	I	J	K
1		Box A					Box C
2	ID	QUANT.	USE DATA	Date	Lot	Batch	QUANT.	USE DATA	Date	Lot	Batch
3	AAA	20	Y	Box A Value	Box A Value	Box A Value	45	N	Box C Value	Box C Value	Box C Value
4	BBB	21	Y	Box A Value	Box A Value	Box A Value	12	N	Box C Value	Box C Value	Box C Value
5	CCC	13	Y	Box A Value	Box A Value	Box A Value	15	N	Box C Value	Box C Value	Box C Value
6	DDD	7	N	Box A Value	Box A Value	Box A Value	11	N	Box C Value	Box C Value	Box C Value
7	EEE	4	N	Box A Value	Box A Value	Box A Value	22	N	Box C Value	Box C Value	Box C Value
8	FFF	9	Y	Box A Value	Box A Value	Box A Value	19	Y	Box C Value	Box C Value	Box C Value
9	GGG	13	Y	Box A Value	Box A Value	Box A Value	4	Y	Box C Value	Box C Value	Box C Value
10	HHH	11	Y	Box A Value	Box A Value	Box A Value	8	Y	Box C Value	Box C Value	Box C Value
11	III	5	Y	Box A Value	Box A Value	Box A Value	3	Y	Box C Value	Box C Value	Box C Value

Worksheet 2

A

B

C

D

E

F

G

H

I

J

K

L

1

Box A ID

Box C ID

2

AAA

FFF

3

BBB

GGG

4

CCC

HHH

5

FFF

III

6

GGG

7

HHH

8

III

 

[DanteAmor]

Hello @cjctmo.

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.​

I give you the macro. You only have to make some adjustments in the macro, but it is very simple.

1. In these lines put the name of your sheets:

  Set sh1 = Sheets("Source")    'Fit to your sheet name
  Set sh2 = Sheets("Output")    'Fit to your sheet name

2. As per your example the headers (ID, QUANT.,USE DATA, Date, Lot, Batch) in sheet1 are in row 2.
But if it is another line, change the 2 to the row number.

  lc = sh1.Cells(2, Columns.Count).End(1).Column

3. According to the above the data starts in cell A3, adjust if necessary.

a = sh1.Range("A3", sh1.Cells(lr, lc)).Value

4. The output will start in cell C2, I guess it should be in column C for consistency with sheet1 and the other columns, like your example column H, adjust if necessary:

  sh2.Rows("2:" & Rows.Count).ClearContents
  sh2.Range("C2").Resize(UBound(b, 1), UBound(b, 2)).Value = b

Put the following macro in a module and run it.

Sub identify_matches()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, m As Long, lr As Long, lc As Long
 
  Set sh1 = Sheets("Source")    'Fit to your sheet name
  Set sh2 = Sheets("Output")    'Fit to your sheet name
  lr = sh1.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  lc = sh1.Cells(2, Columns.Count).End(1).Column
  a = sh1.Range("A3", sh1.Cells(lr, lc)).Value
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
 
  m = 1
  For j = 3 To UBound(a, 2) Step 5
    k = 0
    For i = 1 To UBound(a, 1)
      If a(i, j) = "Y" Then
        k = k + 1
        b(k, m) = a(i, 1)
      End If
    Next
    m = m + 5
  Next
 
  sh2.Rows("2:" & Rows.Count).ClearContents
  sh2.Range("C2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

HOW TO INSTALL MACROs
------------------------------------​

If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (identify_matches) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "Yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.​

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

 

[cjctmo]

Hello @cjctmo.

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.​

I give you the macro. You only have to make some adjustments in the macro, but it is very simple.

1. In these lines put the name of your sheets:

  Set sh1 = Sheets("Source")    'Fit to your sheet name
  Set sh2 = Sheets("Output")    'Fit to your sheet name

2. As per your example the headers (ID, QUANT.,USE DATA, Date, Lot, Batch) in sheet1 are in row 2.
But if it is another line, change the 2 to the row number.

  lc = sh1.Cells(2, Columns.Count).End(1).Column

3. According to the above the data starts in cell A3, adjust if necessary.

a = sh1.Range("A3", sh1.Cells(lr, lc)).Value

4. The output will start in cell C2, I guess it should be in column C for consistency with sheet1 and the other columns, like your example column H, adjust if necessary:

  sh2.Rows("2:" & Rows.Count).ClearContents
  sh2.Range("C2").Resize(UBound(b, 1), UBound(b, 2)).Value = b

Put the following macro in a module and run it.

Sub identify_matches()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, m As Long, lr As Long, lc As Long
 
  Set sh1 = Sheets("Source")    'Fit to your sheet name
  Set sh2 = Sheets("Output")    'Fit to your sheet name
  lr = sh1.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  lc = sh1.Cells(2, Columns.Count).End(1).Column
  a = sh1.Range("A3", sh1.Cells(lr, lc)).Value
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
 
  m = 1
  For j = 3 To UBound(a, 2) Step 5
    k = 0
    For i = 1 To UBound(a, 1)
      If a(i, j) = "Y" Then
        k = k + 1
        b(k, m) = a(i, 1)
      End If
    Next
    m = m + 5
  Next
 
  sh2.Rows("2:" & Rows.Count).ClearContents
  sh2.Range("C2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

HOW TO INSTALL MACROs
------------------------------------​

If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (identify_matches) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "Yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.​

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

@DanteAmor Thank you very much for your response. I greatly appreciate it.
I was able to use your code and detailed instructions to modify it a bit more specifically for my needs. However, I ran into an issue.
I want to changed m = m + 19 to m = m + 22 so that I can output the lists of values every 22 columns starting with column A but if I go greater than 19, I receive a "subscript out or range" error. How can I fix this? And is there a way to clear content from only the range of cells in the columns data was outputted rather than the entire row? I have data between the columns in the output sheet that I do not want deleted. Thank you.

Sub identify_matches()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, m As Long, lr As Long, lc As Long
 
  Set sh1 = Sheets("Source")       'Fit to your sheet name
  Set sh2 = Sheets("Output")                   'Fit to your sheet name
  lr = sh1.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  lc = sh1.Cells(6, Columns.Count).End(1).Column    'Header row in source
  a = sh1.Range("A7", sh1.Cells(lr, lc)).Value      'Data start position in source
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
 

'J = changed to 20 because first column to search is column T. 
'Step changed to 15 to check every 15 columns after the first column. 
 
m = 1
  For j = 20 To UBound(a, 2) Step 15    
    k = 0
    For i = 1 To UBound(a, 1)
      If a(i, j) = "A" Then
        k = k + 1
        b(k, m) = a(i, 1)
      End If
    Next
    m = m + 19  'Error if > 19
  Next
 
  sh2.Rows("7:" & Rows.Count).ClearContents
  sh2.Range("A7").Resize(UBound(b, 1), UBound(b, 2)).Value = b
 
End Sub

 

[DanteAmor]

Your explanation and your examples must be based on a real structure, otherwise no macro will work.

And is there a way to clear content from only the range of cells in the columns data was outputted rather than the entire row?

In your example sheet2 has empty data, I cannot assume that you are really going to have data.

-----------

I made the adjustments with the descriptions that you mentioned in the previous post, try the following:

Sub identify_matches()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant
  Dim i&, j&, k&, m&, lr&, lc&
  
  Application.ScreenUpdating = False
  
  Set sh1 = Sheets("Source")                          'Fit to your sheet name
  Set sh2 = Sheets("Output")                          'Fit to your sheet name
  lr = sh1.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  lc = sh1.Cells(6, Columns.Count).End(1).Column      'Header row in source
  a = sh1.Range("A7", sh1.Cells(lr, lc)).Value        'Data start position in source
  
  m = 1
  For j = 20 To UBound(a, 2) Step 15
    k = 6
    sh2.Range(sh2.Cells(7, m), sh2.Cells(Rows.Count, m)).ClearContents
    For i = 1 To UBound(a, 1)
      If a(i, j) = "Y" Then
        k = k + 1
        sh2.Cells(k, m).Value = a(i, 1)
      End If
    Next
    m = m + 22
  Next
  Application.ScreenUpdating = True
End Sub

 

[cjctmo]

Your explanation and your examples must be based on a real structure, otherwise no macro will work.


In your example sheet2 has empty data, I cannot assume that you are really going to have data.

-----------

I made the adjustments with the descriptions that you mentioned in the previous post, try the following:

Sub identify_matches()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant
  Dim i&, j&, k&, m&, lr&, lc&
 
  Application.ScreenUpdating = False
 
  Set sh1 = Sheets("Source")                          'Fit to your sheet name
  Set sh2 = Sheets("Output")                          'Fit to your sheet name
  lr = sh1.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  lc = sh1.Cells(6, Columns.Count).End(1).Column      'Header row in source
  a = sh1.Range("A7", sh1.Cells(lr, lc)).Value        'Data start position in source
 
  m = 1
  For j = 20 To UBound(a, 2) Step 15
    k = 6
    sh2.Range(sh2.Cells(7, m), sh2.Cells(Rows.Count, m)).ClearContents
    For i = 1 To UBound(a, 1)
      If a(i, j) = "Y" Then
        k = k + 1
        sh2.Cells(k, m).Value = a(i, 1)
      End If
    Next
    m = m + 22
  Next
  Application.ScreenUpdating = True
End Sub

Thank you for all your efforts, The adjustments worked perfectly.

Your explanation and your examples must be based on a real structure, otherwise no macro will work.
In your example sheet2 has empty data, I cannot assume that you are really going to have data.

Apologies. I will keep this in mind. I should have used real structure which would have avoided you having to make twice the effort to help.