Searching and Pulling from a Range VBA

[HTMLGhozt]

Hello,

I would say I'm relatively new to VBA in particular, and this site as well (it's my first post!).

I am working with Excel 2010.

I need help designing a macro to search a range (B, C in the case of the table below) and based on if a cell in the range has text (B1, B3, B5, B7, C1, C4, C5), for the macro to copy that cell and a cell from column A (A1 & B1, A1 & C1, A3 & B3, etc.) to paste into output in the order of column A then the other column.

[TABLE="class: grid, width: 700"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]Output[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]John Smith[/TD]
[TD]Not Paid[/TD]
[TD]Not in Payroll System[/TD]
[TD]John Smith Not Paid[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]James Smith[/TD]
[TD][/TD]
[TD][/TD]
[TD]John Smith Not in Payroll System[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Matthew Smith[/TD]
[TD]Not Paid[/TD]
[TD][/TD]
[TD]Matthew Smith Not Paid[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Michelle Pfeiffer[/TD]
[TD][/TD]
[TD]Is an actress[/TD]
[TD]Michelle Pfeiffer Is an actress[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]HTMLGhozt[/TD]
[TD]Not Paid[/TD]
[TD]Is me![/TD]
[TD]HTMLGhozt Not Paid[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Stacy Keibler[/TD]
[TD][/TD]
[TD][/TD]
[TD]HTMLGhozt Is me![/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]Apples Galore[/TD]
[TD]Is Apples[/TD]
[TD][/TD]
[TD]Apples Galore Is Apples[/TD]
[/TR]
</tbody>[/TABLE]

If you have any questions please ask!

 

[HTMLGhozt]

Is there no one who can do this, or is my phrasing ambiguous?

 

[hiker95]

HTMLGhozt,

Here is a macro solution for you to consider, that uses two arrays in memory, and, runs in the active worksheet.

Sample raw data:

Excel 2007
	A	B	C	D
1	John Smith	Not Paid	Not in Payroll System
2	James Smith
3	Matthew Smith	Not Paid
4	Michelle Pfeiffer		Is an actress
5	HTMLGhozt	Not Paid	Is me!
6	Stacy Keibler
7	Apples Galore	Is Apples
8
9
Sheet1

After the macro:

Excel 2007
	A	B	C	D
1	John Smith	Not Paid	Not in Payroll System	John Smith Not Paid
2	James Smith			John Smith Not in Payroll System
3	Matthew Smith	Not Paid		Matthew Smith Not Paid
4	Michelle Pfeiffer		Is an actress	Michelle Pfeiffer Is an actress
5	HTMLGhozt	Not Paid	Is me!	HTMLGhozt Not Paid
6	Stacy Keibler			HTMLGhozt Is me!
7	Apples Galore	Is Apples		Apples Galore Is Apples
8
9
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ReorgData()
' hiker95, 06/04/2015, ME859228
Dim a As Variant, o As Variant
Dim i As Long, j As Long, n As Long, c As Long
Application.ScreenUpdating = False
With ActiveSheet
  a = .Range("A1:C" & .Cells(Rows.Count, 1).End(xlUp).Row)
  n = Application.CountA(.Range("B1:C" & UBound(a, 1)))
  ReDim o(1 To n + 1, 1 To 1)
  For i = 1 To UBound(a, 1)
    For c = 2 To UBound(a, 2)
      If Not a(i, c) = vbEmpty Then
        j = j + 1: o(j, 1) = a(i, 1) & " " & a(i, c)
      End If
    Next c
  Next i
  .Columns(4).ClearContents
  .Cells(1, 4).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(4).AutoFit
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .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.

Then run the ReorgData macro.

 

[HTMLGhozt]

I attempted to use the code reworking what I could see for what I need it for, I received: "run-time error '9': Subscript out of range". When attempting to debug it highlights specifically j = j + 1: o(j, 1) = a(i, 1) & " " & a(i, c) This. perhaps it's an issue of columns. I am pulling info from columns "S" through "X", with "T" through "X" being my errors. Here's my code verbatim

Sub ReorgData()
' hiker95, 06/04/2015, ME859228
Dim a As Variant, o As Variant
Dim i As Long, j As Long, n As Long, c As Long
Application.ScreenUpdating = False
With ActiveSheet
  a = .Range("S4:X" & .Cells(Rows.Count, 1).End(xlUp).Row)
  n = Application.CountA(.Range("T4:X" & UBound(a, 1)))
  ReDim o(1 To n + 1, 1 To 1)
  For i = 1 To UBound(a, 1)
    For c = 2 To UBound(a, 2)
      If Not a(i, c) = vbEmpty Then
        j = j + 1: o(j, 1) = a(i, 1) & " " & a(i, c)
      End If
    Next c
  Next i
  .Columns(4).ClearContents
  .Cells(1, 4).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(4).AutoFit
End With
End Sub

 

[hiker95]

HTMLGhozt,

I attempted to use the code reworking what I could see for what I need it for, I received: "run-time error '9': Subscript out of range". When attempting to debug it highlights specifically j = j + 1: o(j, 1) = a(i, 1) & " " & a(i, c) This. perhaps it's an issue of columns. I am pulling info from columns "S" through "X", with "T" through "X" being my errors. Here's my code verbatim

The macro that I wrote was based on your posted raw data in columns A, B, and, C, and, the results in column D.

It is always best to display your actual raw data worksheet(s), and, the results that you are looking for. This way we can usually find a solution on the first go.

So that I can get it right on the next try, and, in order to continue I will have to see your actual raw data workbook/worksheet(s), and, what the results should look like (manually formatted by you).

You can upload your workbook to (the BLUE link-->) Box Net ,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

If you are not able to provide the above, then:

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.

 

[HTMLGhozt]

[TABLE="class: grid, width: 1000"]
<tbody>[TR]
[TD]Member Names[/TD]
[TD]Member Not listed[/TD]
[TD]Family Not listed[/TD]
[TD]Date Incorrect[/TD]
[TD]Enrollment Incorrect[/TD]
[TD]Member Not listed 2[/TD]
[TD]Member Names 2[/TD]
[TD]Output[/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Isn't Listed[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Isn't Listed 2[/TD]
[TD]Joh Smith[/TD]
[TD]John Smith Isn't Listed[/TD]
[/TR]
[TR]
[TD]James Smith[/TD]
[TD][/TD]
[TD]Fam Not Listed[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Alphie Smith[/TD]
[TD]John Smith Isn't listed 2[/TD]
[/TR]
[TR]
[TD]Alphie Smith[/TD]
[TD][/TD]
[TD][/TD]
[TD]Date Mismatch[/TD]
[TD]Enrollment Mismatch[/TD]
[TD][/TD]
[TD]Traci Smith[/TD]
[TD]James Smith Fam Not listed[/TD]
[/TR]
[TR]
[TD]Traci Smith[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Isn't Listed 2[/TD]
[TD]James S.[/TD]
[TD]Alphie Smith Date Mismatch[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Alphie Smith Enrollment Mismatch[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]James S. Isn't Listed 2[/TD]
[/TR]
</tbody>[/TABLE]

I am limited to some things; however, here's a conspicuously similar (same amount of rows, same things I need it to do, same order) mock version. The columns are from S to Z. I am working with VBA on the Excel 2010, Please let me know if you need anything else. I can range from four members to 500.

 

[HTMLGhozt]

I managed to get it working by playing around some, I'm sure there's something that it won't do or at some time it may malfunction, but here's the code I have. You sir, are brilliant!

Sub ReorgData()
' hiker95, 06/04/2015, ME859228
Dim a As Variant, o As Variant
Dim i As Long, j As Long, n As Long, c As Long
Application.ScreenUpdating = False
With ActiveSheet
  a = .Range("S4:X" & .Cells(Rows.Count, 1).End(xlUp).Row)
  n = Application.CountA(.Range("T4:X" & UBound(a, 1)))
  ReDim o(1 To n + 1, 1 To 1)
  For i = 1 To UBound(a, 1)
    For c = 2 To UBound(a, 2)
      If Not a(i, c) = vbEmpty Then
        j = j + 1: o(j, 1) = a(i, 1) & " " & a(i, c)
      End If
    Next c
  Next i
  .Columns(8).ClearContents
  .Cells(4, 26).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(8).AutoFit
End With
End Sub

 

[hiker95]

HTMLGhozt,

I managed to get it working by playing around some

It is always best to display your actual raw data worksheet(s), and, the results that you are looking for. This way we can usually find a solution on the first go.

Glad that you were able to adjust the macro to work correctly with your actual raw data structure.

You sir, are brilliant!

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[hiker95]

HTMLGhozt,

Here is another macro for you to consider, based on the new raw data structure, and, results, and, based on the macro you updated/modified.

Sample raw data, and, results:

Excel 2007
	S	T	U	V	W	X	Y	Z
1
2
3	Member Names	Member Not listed	Family Not listed	Date Incorrect	Enrollment Incorrect	Member Not listed 2	Member Names 2	Output
4	John Smith	Isn't Listed				Isn't Listed 2	Joh Smith	John Smith Isn't Listed
5	James Smith		Fam Not Listed				Alphie Smith	John Smith Isn't Listed 2
6	Alphie Smith			Date Mismatch	Enrollment Mismatch		Traci Smith	James Smith Fam Not Listed
7	Traci Smith					Isn't Listed 2	James S.	Alphie Smith Date Mismatch
8								Alphie Smith Enrollment Mismatch
9								Traci Smith Isn't Listed 2
10
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub ReorgDataV2()
' hiker95, 06/08/2015, ME859228
Dim a As Variant, o As Variant
Dim i As Long, j As Long, lr As Long, n As Long, c As Long
Application.ScreenUpdating = False
With ActiveSheet
  .Range("Z3:Z" & .Cells(Rows.Count, "Z").End(xlDown).Row).ClearContents
  lr = .Cells(Rows.Count, "S").End(xlUp).Row
  a = .Range("S4:X" & lr)
  n = Application.CountA(.Range("T4:X" & lr))
  ReDim o(1 To n, 1 To 1)
  For i = 1 To UBound(a, 1)
    For c = 2 To UBound(a, 2)
      If Not a(i, c) = vbEmpty Then
        j = j + 1: o(j, 1) = a(i, 1) & " " & a(i, c)
      End If
    Next c
  Next i
  .Cells(3, 26).Value = "Output"
  .Cells(4, 26).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(26).AutoFit
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .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.

Then run the ReorgDataV2 macro.

 

[HTMLGhozt]

Thank you so much, works perfectly