Exporting multiple rows from a spreadsheet based of criteria for a single row.

[Todes Angst]

Hi All,
I've got a situation in a spreadsheet i'm working with where I have to identify all the occurrences of a certain value in a specified column and export the rows. I have been using this macro script to good effect when I need to extract a single row:

Sub cpyX()
Dim lr As Long, rng As Range, sh As Worksheet
Dim nWB As Workbook, sh2 As Worksheet, lr2 As Long
Set sh = ThisWorkbook.ActiveSheet
lr = sh.Cells(Rows.Count, 4).End(xlUp).Row
Set rng = Range("C2:C" & lr)
Set nWB = Workbooks.Add
ActiveWorkbook.SaveAs Filename:="<--output dir and filename---->"
Set sh2 = nWB.Sheets(1)
For Each c In rng
If UCase(c) = "<---search text --->" Then
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
c.EntireRow.Copy sh2.Range("A" & lr2 + 1)
End If
Next
End Sub

Now in the spreadsheet (see below) I want to find all instances of the cells in C$:C$ that contain the text "Duplicate Of XXXXXXXX" and export them to another worksheet (Exactly like the script above would do). However, the cells containing the "Duplicates" are generated using "=CONCATENATE("DUPLICATEOF",<another cell="">)" type functions and are all unique. SO I've used conditional formatting to change their color to green and then used a standard color filter to filter them. HOWEVER, I also need to export the row directly above each "Duplicate" row at the same time (i.e the "original" and the "duplicate" rows together).


Can someone suggest a way to do this?

</another>

 

[DocAElstein]

. Hi
. You have explained your problem quite well. But I think your spreadsheet screen shot was originally some sort of picture. (I do not strangely see it at all now??) So anyone wanting to use you data when trying to solve your problem would have to type everything in manually!

. Can you Try to provide Tables that can be copied into a spreadsheet showing example data but also importantly exactly how the final output should look like in the Excel File based on your actual example data.


. There are various ways to do this. The first is preferred by this Forum for excel files as then everyone can see wot is going on quickly.. The Third method I prefer. - Then one can get on straight away with writing a code for you in the file you provide.

. 1 If you can, try uploading this, https://onedrive.live.com/?cid=8cffd...CE27E813%21189 instructions here MrExcel HTML Maker . This free Excel add-In is good for screen shots here of spreadsheets. Then everyone can quickly see what is going on and follow the Thread easily.
Or
. 2 Up left in the Thread editor is a table icon. Click that, create an appropriately sized table and fill it in. (To get this icon up in the Reply window you may need to click on the “Go Advanced” Button next to the Reply Button)
Or
. 3 Supply us with example Excel files (Can of course be shortened, or made - up data in case any info is sensitive)
. For example send over these 2 free things: FileSnack | Easy file sharing or Box Net,
Remember to select Share after uploading and give us the link they provide.

Alan
Bavaria.

Übrigens, von was haben sie Todes Angst?

 

[Todes Angst]

Hi Alan,
Thanks for the reply, I'll endeavor to try an supply some examples here but I am currently in a very remote mine site in Western Australia and I am using a very slow Satellite internet connection that is locked down tighter than the Bayern defense and doesn't allow access to most sharing sites. I'll see if I can upload an excel file somewhere.

success: http://www.users.on.net/~michael.field/sheet.xlsx

In that example file I want to be able to search through the whole database (the full DB is 6000+ rows) and extract out the rows containing "Duplicate of" in (Column C) and also the row directly above each duplicate (e.g. When the macro or script is run I want to get rows 12-13, 32-33, etc exported out to a separate workbook). The "Duplicates" occur every 20 sample numbers so, 12-13,32-33, 52-53 etc

As for the name Todes Angst, it is from 2004 when I returned to Australia after living in Germany (Ulm 1999 - 2004, yay Bavaria ) and had to deal with the shockingly bad internet options of Australia compared to Germany. ADSL was relatively new and some people (like me) didn't have it and were still on dial up. I was trying to play Counterstrike on 56K dial-up against people on ADSL. So I called myself "Todes Angst" and hid a lot in the CS maps so as to last more than 5 secs per round

 

[DocAElstein]

Hi „Todes Angst“
. Your File came up Ok and it looked like simple problem but I got called away!... No one has answered in the meantime so for now here is a solution from a beginner to be going on with.. (I expect there are infinite ways to do it and my attempt here is probably somewhat naïve)…


. Assuming your file as you sent me is something like this:

Book1
	A	B	C	D	E	F
1	Sample_Id	HOLE ID	From	Assay No	Fire Assay Au
2	14MRC5105311	14MRC051	28	14MRC05105311	X
3	14MRC5105312	14MRC051	29	14MRC05105312	X
4	14MRC5105313	14MRC051	30	14MRC05105313	X
5	14MRC5105314	14MRC051	31	14MRC05105314	X
6	14MRC5105315	14MRC051	32	14MRC05105315	X
7	14MRC5105316	14MRC051	33	14MRC05105316	0.01
8	14MRC5105317	14MRC051	34	14MRC05105317	X
9	14MRC5105318	14MRC051	35	14MRC05105318	X
10	14MRC5105319	14MRC051	36	14MRC05105319	0.02
11	14MRC5105320	14MRC051	STD	14MRC05105320	13.5
12	14MRC5105321	14MRC051	37	14MRC05105321	X
13	14MRC5105322	14MRC051	DUPLICATEOF14MRC5105321	14MRC05105322	X
14	14MRC5105323	14MRC051	38	14MRC05105323	X
15	14MRC5105324	14MRC051	39	14MRC05105324	X
Sheet1

. And you want the new file to look something like this:

Book1
	A	B	C	D	E
1	Sample_Id	HOLE ID	From	Assay No	Fire Assay Au
2	14MRC5105321	14MRC051	37	14MRC05105321	X
3	14MRC5105322	14MRC051	DUPLICATEOF14MRC5105321	14MRC05105322	X
4	14MRC5105341	14MRC051	55	14MRC05105341	0.52
5	14MRC5105342	14MRC051	DUPLICATEOF14MRC5105341	14MRC05105342	0.48
6
7
Tabelle1

. Here is the modified code:


<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> cpyX2()<br><SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, rng <SPAN style="color:#00007F">As</SPAN> Range, sh <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Dim</SPAN> nWB <SPAN style="color:#00007F">As</SPAN> Workbook, sh2 <SPAN style="color:#00007F">As</SPAN> Worksheet, lr2 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><SPAN style="color:#00007F">Set</SPAN> sh = ThisWorkbook.ActiveSheet<br>lr = sh.Cells(Rows.Count, 4).End(xlUp).Row<br><SPAN style="color:#00007F">Set</SPAN> rng = Range("C2:C" & lr)<br><SPAN style="color:#00007F">Set</SPAN> nWB = Workbooks.Add<br>ActiveWorkbook.SaveAs Filename:="sheetTodesAngst2"<br><SPAN style="color:#00007F">Set</SPAN> sh2 = nWB.Sheets(1)<br>  <SPAN style="color:#00007F">With</SPAN> sh1<br>    Columns("D:D").Insert <SPAN style="color:#007F00">' Add an extra tempoy Column</SPAN><br>    Columns("D:D").Value = Columns("C:C").Value <SPAN style="color:#007F00">' Copy value Column C to tempory Column D</SPAN><br>  <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>  sh.Rows(1).EntireRow.Copy Destination:=sh2.Rows(1)<br>  <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> rng<br>    <SPAN style="color:#00007F">If</SPAN> Left(UCase(c), 9) = "DUPLICATE" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#007F00">' Check for DUPLICATE  in first 9 characters</SPAN><br>    lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row<br>    c.EntireRow.Offset(-1, 0).Copy Destination:=sh2.Range("A" & lr2 + 1)<br>    c.EntireRow.Copy sh2.Range("A" & lr2 + 2)<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>  <SPAN style="color:#00007F">Next</SPAN><br>  sh.Columns("D:D").Delete <SPAN style="color:#007F00">'Delete the tempory column in..</SPAN><br>  sh2.Columns("D:D").Delete <SPAN style="color:#007F00">'... both sheets</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

. It basically makes a temporary row with the values of wot is in column C in it. Part of that is then used for the comparison (The DUPLICATE bit). Then at the end, that unwanted temporary column is deleted.


. Here is the returned file to you with macro in Sheet1 module
FileSnack | Easy file sharing

. If you need any more help then get back.
....no worries, Keine (Todes) Angst!!

. Alan Elston

 

[Todes Angst]

Brilliant work Alan. Seems to be 99% of the way there. Your script is identifying the correct rows and copying them no problems. The script has however uncovered an inherent problem with this spreadsheet (as you can imagine this massive database has been developed and edited by several different people over the life of the document). Some of the copied rows are still trying to reference other cells for their values and these references are of course invalid as soon as the rows are copied out to the new worksheet causing many cells to display "#REF" errors once moved. Is it possible to modify your script to copy only the values in the cells and not the formulas etc (i.e. Like paste special values only)?

Thanks very much for your help.

EDIT: Actually, no need to change it. I have made a work around that has fixed the problem. The original columns C & D in the spreadsheet are all user entered data so I just copied the entire columns and pasted them back in as "Values only". Your script now does exactly what I needed. Vielen Dank

 

[DocAElstein]

Brilliant work Alan. Seems to be 99% of the way there…………….Vielen Dank

You are Welcome. And many thanks for the feedback. That is always appreciated. Danke!

…… Is it possible to modify your script to copy only the values in the cells and not the formulas etc (i.e. Like paste special values only)?..........QUOTE]

. That is dead easy. And can probably be done as you said with paste Special stuff, but I could not quite get that to work?
. But this simple mod does just as well. - New modified code:



<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> cpyX4() <SPAN style="color:#007F00">'Copy only Values</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, rng <SPAN style="color:#00007F">As</SPAN> Range, sh <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Dim</SPAN> nWB <SPAN style="color:#00007F">As</SPAN> Workbook, sh2 <SPAN style="color:#00007F">As</SPAN> Worksheet, lr2 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><SPAN style="color:#00007F">Set</SPAN> sh = ThisWorkbook.ActiveSheet<br>lr = sh.Cells(Rows.Count, 4).End(xlUp).Row<br><SPAN style="color:#00007F">Set</SPAN> rng = Range("C2:C" & lr)<br><SPAN style="color:#00007F">Set</SPAN> nWB = Workbooks.Add<br>ActiveWorkbook.SaveAs Filename:="sheetTodesAngst2"<br><SPAN style="color:#00007F">Set</SPAN> sh2 = nWB.Sheets(1)<br>  <SPAN style="color:#00007F">With</SPAN> sh1<br>    Columns("D:D").Insert <SPAN style="color:#007F00">' Add an extra tempoy Column</SPAN><br>    Columns("D:D").Value = Columns("C:C").Value <SPAN style="color:#007F00">' Copy value Column C to tempory Column D</SPAN><br>  <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>  sh.Rows(1).EntireRow.Copy Destination:=sh2.Rows(1)<br>  <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> rng<br>    <SPAN style="color:#00007F">If</SPAN> Left(UCase(c), 9) = "DUPLICATE" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#007F00">' Check for DUPLICATE  in first 9 characters</SPAN><br>    lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row<br>    sh2.Range("A" & lr2 + 1).EntireRow.Value = c.EntireRow.Offset(-1, 0).Value<br>    sh2.Range("A" & lr2 + 2).EntireRow.Value = c.EntireRow.Value<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>  <SPAN style="color:#00007F">Next</SPAN><br>  sh.Columns("D:D").Delete <SPAN style="color:#007F00">'Delete the tempory column in..</SPAN><br>  sh2.Columns("D:D").Delete <SPAN style="color:#007F00">'... both sheets</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>




(Modified code again with modified bit shown in Red)

Sub cpyX4() 'Copy only Values
Dim lr As Long, rng As Range, sh As Worksheet
Dim nWB As Workbook, sh2 As Worksheet, lr2 As Long
Set sh = ThisWorkbook.ActiveSheet
lr = sh.Cells(Rows.Count, 4).End(xlUp).Row
Set rng = Range("C2:C" & lr)
Set nWB = Workbooks.Add
ActiveWorkbook.SaveAs Filename:="sheetTodesAngst2"
Set sh2 = nWB.Sheets(1)
  With sh1
    Columns("D:D").Insert ' Add an extra tempoy Column
    Columns("D:D").Value = Columns("C:C").Value ' Copy value Column C to tempory Column D
  End With
  sh.Rows(1).EntireRow.Copy Destination:=sh2.Rows(1)
  For Each c In rng
    If Left(UCase(c), 9) = "DUPLICATE" Then ' Check for DUPLICATE  in first 9 characters
    lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
[COLOR=#FF0000]    sh2.Range("A" & lr2 + 1).EntireRow.Value = c.EntireRow.Offset(-1, 0).Value
    sh2.Range("A" & lr2 + 2).EntireRow.Value = c.EntireRow.Value[/COLOR]
    End If
  Next
  sh.Columns("D:D").Delete 'Delete the tempory column in..
  sh2.Columns("D:D").Delete '... both sheets
End Sub

]……..[/B]EDIT: Actually, no need to change it. I have made a work around that has fixed the problem. The original columns C & D in the spreadsheet are all user entered data so I just copied the entire columns and pasted them back in as "Values only". Your script now does exactly what I needed….

. If you do that then my code can be simplified without the extra temporary Column. But It might be an idea to use the new code and preserve the format of the original data – you know “Sod’s Law” – you might find in the future you need the original format!

. Alan

 

[Todes Angst]

Just FYI, I gave your revised code that copies only the "values" in the cells a try and it works exactly how I wanted it to. Thanks again

 

[DocAElstein]

Just FYI, I gave your revised code that copies only the "values" in the cells a try and it works exactly how I wanted it to. Thanks again

. Your welcome. And thanks for that feedback. That is much appreciated.

Schönen Abend noch ohne Angst!
Alan.