Solved: Search for Values and copy certain columns to different worksheet

[anthony20069]

Hi guys,

Been a while since I have played around with VAB, so need some guidance if possible...

I have a workbook that has 2 worksheets.

Sheet2 has a column of values e.g. Router, PC, Laptop, Cables etc etc ( Starting in column C6) - they are all unique values btw

Sheet1 also has the same values but are in different columns.... the range of this A3:DI1563 [so quite a large range :) ]

What i am trying to do is search for the first value (Router) when it finds it, i need to copy the values in the columns ( G, J,I, L,O,R,W) from Sheet1 into Columns D-J in sheet2 on the same row as Router

I am currently playing around with the Cells.Find(What:= SearchValue Function(?) but it's taking a while :)

any

[BrianMH]

Is there any reason you don't want to use vlookup?

[anthony20069]

Sorry, should have mentioned as well... the file that is being looked at is a data dump so it changes all the time.

At the end of this "data transformation", a CSV file is going to be created, so essentially i have another workbook that opens this data dump file, does the transformation and then creates a csv.

Hope that makes sense?

***Update***

Managed to find one value and copy and paste the required columns into the other spreadsheet

With ActiveSheet

.Cells.Find(What:="Router", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate

.Range("j63,k63,l63,m63,n63,o63,p63").Select
Selection.Copy
Sheets("SheetName").Select

With ActiveSheet
.Range("D6").Select
ActiveSheet.Paste
End With



now just need to figure out the looping part :)

[BrianMH]

I have attached a sample of what I believe you need. The VBA is in module 1 of book 1. Change the paths as necessary.

[anthony20069]

Thanks for that BrianMH!

It sort of does what i am attempting to do, so many thanks for helping out.

How easy would it be to modify it so it worked like this:

In Book1 there would be a set of "instructions/Criteria" (this would be manually inputted)

Which would look in Book2 on the given row & criteria and then copy across...

I have modified those Books and attached to give a better view of what i am aiming for...

Again, many thanks for the help....

[BrianMH]

I don't see any changes to book 1 so not really clear on what you need.

[anthony20069]

Apologies for that, zipped the wrong one.... this should be the right one

[BrianMH]

Do you want a results tab to be in the workbook you are searching or in the workbook you put the criteria in?

[anthony20069]

If possible to appear in the workbook you are searching?

[BrianMH]

In the first 9 columns is there ever anything other than 1 value per row? It looks like to me you are just trying to move everything in 1 line with no spaces.

[anthony20069]

No, there will be other values in those columns(all cells will have a value), left it blank to make it easier to see what i was attempting to achieve.

[BrianMH]

Ok but the values will always be in the same columns right? Will you only be doing this once per workbook? Is the sheet you search named and if so always the same name? Do you want the results sheet to be named and where do you want it positioned? If you are going in and looking at the spreadsheet to find what column the values are in the first place are you sure this is going to save you time?

Maybe if you give us a scenario of what/why you are trying to achieve this would be easier. I can do it exactly as you say but unless these things are answered you are going to find it comes up with errors in the future.

[anthony20069]

Ok but the values will always be in the same columns right?
- well no, this is why i thought having a column (in book1 "B") that would say, look in this Column for the search Criteria (col C) - the majority of them once set will remain the same each time. every week a new data dump is produced, so some things are taken out and some are added.

Will you only be doing this once per workbook
- this will be done over a couple workbooks

Is the sheet you search named and if so always the same name?
- yes the name will always be the same

do you want the results sheet to be named and where do you want it positioned?
- the final outcome would be a CSV file created called "Search_Results.CSV"

If you are going in and looking at the spreadsheet to find what column the values are in the first place are you sure this is going to save you time?
- Yes, initially it will take a bit of time to set the columns and search, but once set, this will save time going forward - especially when creating the CSV


So the scenario would be once a week a file is delivered. We would then load up Book1 and initially fill in the column and search criteria, this would then search and format Book2 to create the required CSV file (called results in book2)

Really do appreciate this, hope this makes sense?

[BrianMH]

What is the name of the sheet that the values will be searched from?

So you don't actually need to modify the workbook you are searching? You just want a csv output from it?

What I meant by values in columns is that the values you pull out (not the ones you search but the columns further to the left) are always the same columns?

In regards to the search terms are they in multiple places in the search spreadsheet? In other words is there actually any need to define the columns being searched or do they actually only appear once in the spreadsheet anyway?

[anthony20069]

What is the name of the sheet that the values will be searched from?
- raw_data_dump.xlsx is the actual name of the spreadsheet (i hope that's what you mean?)

So you don't actually need to modify the workbook you are searching? You just want a csv output from it?
- Correct, its just searching for values and then pulling out the data on those certain columns (these will always be the same columns each time) and then putting it all into a CSV file

the need to define the column being searched is that intially we are not sure what column is going to be used to find the search criteria, untill we get the data dump, they can appear multiple times, if this happens, we just need to copy each value it finds and move to the CSV file as well...

[BrianMH]

What is the name of the sheet that the values will be searched from?
- raw_data_dump.xlsx is the actual name of the spreadsheet (i hope that's what you mean?)


I mean the name of the worksheet in the workbook. Is it just sheet1 or is it named?

[anthony20069]

ah, yes its just sheet1

[BrianMH]

In the first 9 columns will you end up needing every populated value exported with the data from the other columns or is it just certain values? If so then we can skip the search altogether.

If not is the list of values you need exporting always the same?

[anthony20069]

no not every populated value...

so the vba will search for a value (or instance in column 5) once it has found the row that it is on, it will then copy "the value name i.e. value-6 - col 5" and the the values on that row from col10,12,14,16,18,19 only and display it like what is shown in the results tab (on book2)

[BrianMH]

Ok.

A few more questions.

Does the source spreadsheet have column headers?

Are the values to search the same every time?

If the value to search appears in more than 1 row or column will you need each instance of that value to be output to the csv with the data columns (10,12,14,16,18,19)? I ask as we may be able to skip the column definition then to speed it up for you and simplify the coding.

Is the data sensitive? If not it might be worth posting an unmodified raw_data_dump.xlsx

[anthony20069]

Ask as many questions as you like :)

Yes it does have Headers, but if you use Col 10 etc, i can change the headers (hopefully :) )

When you mean "the values to search" are you talking what is under Col 1 - 9 if so; they can change in some instances but generally they would remain the same....

Unfortunately i am not able to share the data dump as it is sensitive, and its too big to try and redact it

[BrianMH]

What I mean by values to search is the list of values and columns on your macro spreadsheet. Will the list of values always be the same that you need to get data for? I understand the columns can change but the actual list of values, does that change?

Say you have a list of values v1, v2, v3, v4 and these appear more than once in columns 1-9 will you need only the first instance of these? Say v1 appears in row 1, row 3 and row 6 in different columns (or even the same columns) do you need each of these to be output or just 1 of them?

[anthony20069]

It did post but on the next page!

they should remain the same each time, but there maybe occasions when some maybe deleted and others added

Thats something we had not taken into account :) for now, can we just say that if it appears more than once just take the first instance....

[BrianMH]

In that case we can skip the columns helper in the macro spreadsheet.

To clarify I know that the values of the data dump spreadsheet change but do the list of values you need to export stay the same or is there an exhaustive list of values that if they exist in the data dump will always need to be output?

[anthony20069]

yes, if they exist, they will always need to be outputted

[BrianMH]

gone out well finish it tomorrow

[BrianMH]

Good morning. I have it sorted now. This will ask you to choose the source file and then ask you where to save the csv. It doesn't save the changes to the source file. Hope this helps!

[anthony20069]

You sir, are a champ!

Thank you very much for this....:thumb:thumb:thumb:thumb

:friends:

[BrianMH]

Your welcome. Glad we got there in the end!

[anthony20069]

Just one more question :)

When i edit the line
Set rCopy = Union(.Cells(c2.Row, 92), .Cells(c2.Row, 72), .Cells(c2.Row, 58), .Cells(c2.Row, 16), .Cells(c2.Row, 87), .Cells(c2.Row, 102))
To change different columns, it doesn't seem to be copying the values - should - have i edited that row incorrectly? - it will find the correct values, just not the copying part - have i broken it already :)

**EDIT**

Also, being cheeky now ;)... how easy would it be to modify the code to say, if the value appears more than once on the same line, then only add it once? if appears on more than one line, added....

[BrianMH]

It will copy the rows in the order they appear on the spreadsheet. If you are trying to rearrange the columns it won't work with copy, which it looks like your trying to do by putting the column numbers in different orders. It should however copy those cells just not rearrange them.

As far as only copying it once on one row the way it is set up you can't do that but since it will just create duplicate rows you can use the remove duplicates function. Change the code in the module to the below.


Option Explicit
Sub test()
Dim wbValues As Workbook
Dim wbFrom As Workbook
Dim wsResults As Worksheet
Dim wsFrom As Worksheet
Dim wsCSV As Worksheet
Dim rValues As Range
Dim rFrom As Range
Dim rTo As Range
Dim c1 As Range
Dim c2 As Range
Dim i As Integer
Dim vcol
Dim rCopy As Range
Set wbValues = ThisWorkbook
Set rValues = wbValues.Sheets(1).Columns(1).SpecialCells(2)
Set wbFrom = Workbooks.Open(Application.GetOpenFilename _
(MultiSelect:=False))
Set wsFrom = wbFrom.Sheets(1)
Set wsCSV = wbFrom.Sheets.Add
Set rTo = wsCSV.Cells(1, 1)
Set rFrom = Intersect(wsFrom.Range("A:I"), wsFrom.UsedRange)
Set rFrom = rFrom.SpecialCells(2)
For Each c1 In rValues.Cells
For Each c2 In rFrom.Cells
If c2.Value = c1.Value Then
rTo = c1.Value
With wsFrom
Set rCopy = Union(.Cells(c2.Row, 10), .Cells(c2.Row, 12), .Cells(c2.Row, 14), .Cells(c2.Row, 16), .Cells(c2.Row, 18), .Cells(c2.Row, 19))
rCopy.Copy
rTo.Offset(0, 1).PasteSpecial
Set rTo = rTo.Offset(1, 0)
End With
End If
Next c2
Next c1
With wsCSV
ReDim vcol(.UsedRange.Columns.Count - 1)
For i = 1 To .UsedRange.Columns.Count
vcol(i - 1) = i
Next

.Range(.UsedRange.Address).RemoveDuplicates Columns:=Evaluate(vcol), Header:=xlNo
.SaveAs svpth & "\ouput.csv", xlCSV
End With

wbFrom.Close (False)
End Sub
Function svpth() As String
'this returns a string for a folder path the user selects
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim strSelectedItem As String
Do
With fd

.Title = "please choose save path"

If .Show = -1 Then
svpth = .SelectedItems.Item(1)
Else
End If

End With
Loop While svpth = ""
End Function

[anthony20069]

Many thanks for that...

And now you are probably going to hate me... i have just been informed that the column being copied across (i.e. where it says .Cells(c2.Row, 92) etc

These will actually vary depending on each spreadsheet being looked at, but they will have the same headings, if that is any consolation... is there anyway to accommodate this with the current code?

[BrianMH]

You will need to define an array of column names in the code where commented.

Option Explicit

Sub test()
Dim wbValues As Workbook
Dim wbFrom As Workbook
Dim wsResults As Worksheet
Dim wsFrom As Worksheet
Dim wsCSV As Worksheet
Dim rValues As Range
Dim rFrom As Range
Dim rTo As Range
Dim c1 As Range
Dim c2 As Range
Dim i As Integer
Dim vcol
Dim rCopy As Range
Dim aHeaders As Variant
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim c3 As Range
Dim c4 As Range
Dim aColumns As Variant
aHeaders = Array("Col 10", "Col 12", "Col 14", "Col 16", "Col 18", "Col 19", "Col 22") 'put your list of headers here. They need to be exact and are case sensitive
ReDim aColumns(UBound(aHeaders))
Set wbValues = ThisWorkbook
Set rValues = wbValues.Sheets(1).Columns(1).SpecialCells(2)
Set wbFrom = Workbooks.Open(Application.GetOpenFilename _
(MultiSelect:=False))
Set wsFrom = wbFrom.Sheets(1)
Set wsCSV = wbFrom.Sheets.Add
Set rTo = wsCSV.Cells(1, 1)
Set rFrom = Intersect(wsFrom.Range("A:I"), wsFrom.UsedRange)
Set rFrom = rFrom.SpecialCells(2)
For Each c1 In rValues.Cells
For Each c2 In rFrom.Cells
If c2.Value = c1.Value Then
rTo = c1.Value
With wsFrom
y = 0
For Each c3 In Intersect(.UsedRange, .Rows(1))
For x = LBound(aHeaders) To UBound(aHeaders)
If c3 = aHeaders(x) Then
aColumns(y) = c3.Column
y = y + 1
End If
Next x
Next c3
Set rCopy = Nothing
For x = LBound(aColumns) To UBound(aColumns)
If rCopy Is Nothing Then
Set rCopy = .Cells(c2.Row, aColumns(x))
Else
Set rCopy = Union(rCopy, .Cells(c2.Row, aColumns(x)))
End If
Next x
y = 1
For Each c4 In rCopy.Cells
rTo.Offset(0, y) = c4
y = y + 1
Next c4
y = 0
Set rTo = rTo.Offset(1, 0)
End With
End If
Next c2
Next c1
With wsCSV
ReDim vcol(.UsedRange.Columns.Count - 1)
For i = 1 To .UsedRange.Columns.Count
vcol(i - 1) = i
Next

.Range(.UsedRange.Address).RemoveDuplicates Columns:=Evaluate(vcol), Header:=xlNo
.SaveAs svpth & "\ouput.csv", xlCSV
End With

wbFrom.Close (False)
End Sub
Function svpth() As String
'this returns a string for a folder path the user selects
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim strSelectedItem As String
Do
With fd

.Title = "please choose save path"

If .Show = -1 Then
svpth = .SelectedItems.Item(1)
Else
End If

End With
Loop While svpth = ""
End Function


Where do you live you owe me a beer? :)

[anthony20069]

Mate, i owe you more than a beer :)

[BrianMH]

I put a loop inside a loop where I shouldn't have. It didn't affect the functionality but made it less efficient. Here is the modified code.

Option Explicit

Sub test()
Dim wbValues As Workbook
Dim wbFrom As Workbook
Dim wsResults As Worksheet
Dim wsFrom As Worksheet
Dim wsCSV As Worksheet
Dim rValues As Range
Dim rFrom As Range
Dim rTo As Range
Dim c1 As Range
Dim c2 As Range
Dim i As Integer
Dim vcol
Dim rCopy As Range
Dim aHeaders As Variant
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim c3 As Range
Dim c4 As Range
Dim aColumns As Variant
aHeaders = Array("Col 10", "Col 12", "Col 14", "Col 16", "Col 18", "Col 19", "Col 22") 'put your list of headers here. They need to be exact and are case sensitive
ReDim aColumns(UBound(aHeaders))
Set wbValues = ThisWorkbook
Set rValues = wbValues.Sheets(1).Columns(1).SpecialCells(2)
Set wbFrom = Workbooks.Open(Application.GetOpenFilename _
(MultiSelect:=False))
Set wsFrom = wbFrom.Sheets(1)
Set wsCSV = wbFrom.Sheets.Add
Set rTo = wsCSV.Cells(1, 1)
Set rFrom = Intersect(wsFrom.Range("A:I"), wsFrom.UsedRange)
Set rFrom = rFrom.SpecialCells(2)
With wsFrom
y = 0
For Each c3 In Intersect(.UsedRange, .Rows(1))
For x = LBound(aHeaders) To UBound(aHeaders)
If c3 = aHeaders(x) Then
aColumns(y) = c3.Column
y = y + 1
End If
Next x
Next c3
End With
For Each c1 In rValues.Cells
For Each c2 In rFrom.Cells
If c2.Value = c1.Value Then
rTo = c1.Value
With wsFrom
Set rCopy = Nothing
For x = LBound(aColumns) To UBound(aColumns)
If rCopy Is Nothing Then
Set rCopy = .Cells(c2.Row, aColumns(x))
Else
Set rCopy = Union(rCopy, .Cells(c2.Row, aColumns(x)))
End If
Next x
y = 1
For Each c4 In rCopy.Cells
rTo.Offset(0, y) = c4
y = y + 1
Next c4
y = 0
Set rTo = rTo.Offset(1, 0)
End With
End If
Next c2
Next c1
With wsCSV
ReDim vcol(.UsedRange.Columns.Count - 1)
For i = 1 To .UsedRange.Columns.Count
vcol(i - 1) = i
Next

.Range(.UsedRange.Address).RemoveDuplicates Columns:=Evaluate(vcol), Header:=xlNo
.SaveAs svpth & "\ouput.csv", xlCSV
End With

wbFrom.Close (False)
End Sub
Function svpth() As String
'this returns a string for a folder path the user selects
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim strSelectedItem As String
Do
With fd

.Title = "please choose save path"

If .Show = -1 Then
svpth = .SelectedItems.Item(1)
Else
End If

End With
Loop While svpth = ""
End Function

[anthony20069]

Thanks for this Brian...

Got another question about this, which i thought i would post here rather than PMing you....

On the tab "Search Criteria" (from Book1) i have added two extra columns A & B with values - Ive been trying to edit your code to copy these values across into the CSV file as well as the search Criteria (currently A now on C) - but not succeeding... Any pointers?

[BrianMH]

Assuming the search values are in column 3 and you want them to print out in the same order on the csv then the below should do. I also discovered an error in my original code in regards to remove duplicates and have fixed that. I've tried to highlight all the changes.


Sub test()
Dim wbValues As Workbook
Dim wbFrom As Workbook
Dim wsResults As Worksheet
Dim wsFrom As Worksheet
Dim wsCSV As Worksheet
Dim rValues As Range
Dim rFrom As Range
Dim rTo As Range
Dim c1 As Range
Dim c2 As Range
Dim i As Integer
Dim vcol
Dim rCopy As Range
Dim aHeaders As Variant
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim c3 As Range
Dim c4 As Range
Dim aColumns As Variant
Dim sCol As String
aHeaders = Array("Col 10", "Col 12", "Col 14", "Col 16", "Col 18", "Col 19", "Col 22") 'put your list of headers here. They need to be exact and are case sensitive
ReDim aColumns(UBound(aHeaders))
Set wbValues = ThisWorkbook
Set rValues = wbValues.Sheets(1).Columns(3).SpecialCells(2)
Set wbFrom = Workbooks.Open(Application.GetOpenFilename _
(MultiSelect:=False))
Set wsFrom = wbFrom.Sheets(1)
Set wsCSV = wbFrom.Sheets.Add
Set rTo = wsCSV.Cells(1, 1)
Set rFrom = Intersect(wsFrom.Range("A:I"), wsFrom.UsedRange)
Set rFrom = rFrom.SpecialCells(2)
With wsFrom
y = 0
For Each c3 In Intersect(.UsedRange, .Rows(1))
For x = LBound(aHeaders) To UBound(aHeaders)
If c3 = aHeaders(x) Then
aColumns(y) = c3.Column
y = y + 1
End If
Next x
Next c3
End With
For Each c1 In rValues.Cells
For Each c2 In rFrom.Cells
If c2.Value = c1.Value Then
With rTo
.Value = c1.Offset(0, -2).Value
.Offset(0, 1) = c1.Offset(0, -1).Value
.Offset(0, 2) = c1.Value
End With
With wsFrom
Set rCopy = Nothing
For x = LBound(aColumns) To UBound(aColumns)
If rCopy Is Nothing Then
Set rCopy = .Cells(c2.Row, aColumns(x))
Else
Set rCopy = Union(rCopy, .Cells(c2.Row, aColumns(x)))
End If
Next x
y = 3
For Each c4 In rCopy.Cells
rTo.Offset(0, y) = c4
y = y + 1
Next c4
y = 3
Set rTo = rTo.Offset(1, 0)
End With
End If
Next c2
Next c1
With wsCSV
ReDim vcol(.UsedRange.Columns.Count - 1)
For i = 1 To .UsedRange.Columns.Count
vcol(i - 1) = i
Next
.Range(.UsedRange.Address).RemoveDuplicates Columns:=(vcol), Header:=xlNo
.SaveAs svpth & "\ouput.csv", xlCSV
End With

wbFrom.Close (False)
End Sub
Function svpth() As String
'this returns a string for a folder path the user selects
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim strSelectedItem As String
Do
With fd

.Title = "please choose save path"

If .Show = -1 Then
svpth = .SelectedItems.Item(1)
Else
End If

End With
Loop While svpth = ""
End Function

[anthony20069]

Hey Brian,

Was going to PM you but thought maybe someone else may find what i am about to ask useful :)

Here we go...

So where you have your "Find & Copy and paste code"
For Each c1 In rValues.Cells For Each c2 In rFrom.Cells If c2.Value = c1.Value Then With rTo .Value = c1.Offset(0, -2).Value .Offset(0, 1) = c1.Offset(0, -1).Value .Offset(0, 2) = c1.Value End With With wsFrom Set rCopy = Nothing For x = LBound(aColumns) To UBound(aColumns) If rCopy Is Nothing Then Set rCopy = .Cells(c2.Row, aColumns(x)) Else Set rCopy = Union(rCopy, .Cells(c2.Row, aColumns(x))) End If Next x y = 3 For Each c4 In rCopy.Cells rTo.Offset(0, y) = c4 y = y + 1 Next c4 y = 3 Set rTo = rTo.Offset(1, 0) End With End If Next c2 Next c1
I've been trying to edit this... to say, if the search is not found variable range c1.Value then when it comes around again and finds the next match; when pasting it must "skip" a row in order to not write the values found in the incorrect row on the CSV file...

Any help or ideas?

**
not sure why its formatting the vba like that?