Find matches in different spreasheets then copy and paste to new s
Hi,
I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. |
Find matches in different spreasheets then copy and paste to new s
what kind of value, how many possible matches per worksheet? Is the new
sheet already there or does the macro need to create it?, etc.............. -- Don Guillett Microsoft MVP Excel SalesAid Software "newlearner01" wrote in message ... Hi, I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. |
Find matches in different spreasheets then copy and paste to new s
Hi,
try this Sub copyrows() Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range MyValue = "Somestring" For x = 1 To 41 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow) Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "newlearner01" wrote: Hi, I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. |
Find matches in different spreasheets then copy and paste to n
Mike:
Very nice use of advanced features. Could you provide me with the proper "type" for the following variables: Dim sht Dim myrange Dim C They were not included in the example. -- Rich Locus Logicwurks, LLC "Mike H" wrote: Hi, try this Sub copyrows() Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range MyValue = "Somestring" For x = 1 To 41 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow) Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "newlearner01" wrote: Hi, I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. |
Find matches in different spreasheets then copy and paste to n
There are less than 20 possible matches per sheet, and I need to create new
sheet. The value is text. Thank for asking. "Don Guillett" wrote: what kind of value, how many possible matches per worksheet? Is the new sheet already there or does the macro need to create it?, etc.............. -- Don Guillett Microsoft MVP Excel SalesAid Software "newlearner01" wrote in message ... Hi, I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. . |
Find matches in different spreasheets then copy and paste to n
Thanks. As Rich said, very nice use of advanced features. Both codes work,
but yours runs very fast. "Mike H" wrote: Hi, try this Sub copyrows() Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range MyValue = "Somestring" For x = 1 To 41 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow) Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "newlearner01" wrote: Hi, I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. |
Find matches in different spreasheets then copy and paste to n
Mike:
Love the speed of the copy solution for this post. Do you know how to just copy the values and not the formatting? The copy statement in your example copies everything, including formatting and cell colors. Is there a way to copy that works more like a "Paste Special, values only?" -- Rich Locus Logicwurks, LLC "Mike H" wrote: Hi, try this Sub copyrows() Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range MyValue = "Somestring" For x = 1 To 41 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow) Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "newlearner01" wrote: Hi, I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. |
Find matches in different spreasheets then copy and paste to n
Dim sht as object
Dim myrange as range Dim C as range -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "Rich Locus" wrote: Mike: Very nice use of advanced features. Could you provide me with the proper "type" for the following variables: Dim sht Dim myrange Dim C They were not included in the example. -- Rich Locus Logicwurks, LLC "Mike H" wrote: Hi, try this Sub copyrows() Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range MyValue = "Somestring" For x = 1 To 41 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow) Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "newlearner01" wrote: Hi, I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. |
Find matches in different spreasheets then copy and paste to n
Yes, it will be great if we have that addition option.
BTW, I would like to add the reference sheet names in the column A, and the copied rows will start from column B of new sheet ("result" in your example) so that we know from where those copied rows come. How can I add sheet names to the Set CopyRange statement? Thanks. "Rich Locus" wrote: Mike: Love the speed of the copy solution for this post. Do you know how to just copy the values and not the formatting? The copy statement in your example copies everything, including formatting and cell colors. Is there a way to copy that works more like a "Paste Special, values only?" -- Rich Locus Logicwurks, LLC "Mike H" wrote: Hi, try this Sub copyrows() Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range MyValue = "Somestring" For x = 1 To 41 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow) Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "newlearner01" wrote: Hi, I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. |
Find matches in different spreasheets then copy and paste to n
Hello again :)
Here's a minor tweak to the code from Mike H that does a Paste Special for values only and doesn't change colors, fonts or anything else: Option Explicit Sub copyrows() Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range Dim sht Dim myrange As Range Dim C ' Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" MyValue = "WhatImLookingFor" For x = 1 To 2 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Sheets("Results").Select Cells(LastRow, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Cells(1, 1).Select Set CopyRange = Nothing End If Next Sheets(1).Select Cells(1, 1).Select End Sub -- Rich Locus Logicwurks, LLC "newlearner01" wrote: Yes, it will be great if we have that addition option. BTW, I would like to add the reference sheet names in the column A, and the copied rows will start from column B of new sheet ("result" in your example) so that we know from where those copied rows come. How can I add sheet names to the Set CopyRange statement? Thanks. "Rich Locus" wrote: Mike: Love the speed of the copy solution for this post. Do you know how to just copy the values and not the formatting? The copy statement in your example copies everything, including formatting and cell colors. Is there a way to copy that works more like a "Paste Special, values only?" -- Rich Locus Logicwurks, LLC "Mike H" wrote: Hi, try this Sub copyrows() Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range MyValue = "Somestring" For x = 1 To 41 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow) Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "newlearner01" wrote: Hi, I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. |
Find matches in different spreasheets then copy and paste to n
Here's another change that allows the rows from the first 41 spreadsheets
(only the first 30 columns are copied, but you can change that to make it bigger or smaller) to be copied to Column B of results, with the name of the spreadsheet in Column A: Sub copyrows() Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range Dim sht Dim myrange As Range Dim C Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" MyValue = "WhatImLookingFor" For x = 1 To 41 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = Range(C, C.Offset(0, 30)) Else Set CopyRange = Union(CopyRange, Range(C, C.Offset(0, 30))) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "B").End(xlUp).Row + 1 CopyRange.Copy Destination:=Sheets("Results").Range("B" & LastRow) Sheets("Results").Cells(LastRow, 1).Value = sht.Name Set CopyRange = Nothing End If Next End Sub -- Rich Locus Logicwurks, LLC "Rich Locus" wrote: Hello again :) Here's a minor tweak to the code from Mike H that does a Paste Special for values only and doesn't change colors, fonts or anything else: Option Explicit Sub copyrows() Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range Dim sht Dim myrange As Range Dim C ' Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" MyValue = "WhatImLookingFor" For x = 1 To 2 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Sheets("Results").Select Cells(LastRow, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Cells(1, 1).Select Set CopyRange = Nothing End If Next Sheets(1).Select Cells(1, 1).Select End Sub -- Rich Locus Logicwurks, LLC "newlearner01" wrote: Yes, it will be great if we have that addition option. BTW, I would like to add the reference sheet names in the column A, and the copied rows will start from column B of new sheet ("result" in your example) so that we know from where those copied rows come. How can I add sheet names to the Set CopyRange statement? Thanks. "Rich Locus" wrote: Mike: Love the speed of the copy solution for this post. Do you know how to just copy the values and not the formatting? The copy statement in your example copies everything, including formatting and cell colors. Is there a way to copy that works more like a "Paste Special, values only?" -- Rich Locus Logicwurks, LLC "Mike H" wrote: Hi, try this Sub copyrows() Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range MyValue = "Somestring" For x = 1 To 41 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow) Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "newlearner01" wrote: Hi, I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. |
Find matches in different spreasheets then copy and paste to n
Thanks again Rich
It's interesting that this version finds more matches than Mike's original code. Somehow, Mike's code ignores hidden rows, and the rows whose first columns are empty. However, yours does not copy/paste first column of the existing sheets. How can we modify code to fix it? Can you please show me how to modify code to search in any column (ex: column 1 or 10)? Also, both codes ignore several matches in a few spreadsheets. When I use Find tool, Excel does overlook those matches too. Is that a bug in Excel? Im using Excel 2007. "Rich Locus" wrote: Here's another change that allows the rows from the first 41 spreadsheets (only the first 30 columns are copied, but you can change that to make it bigger or smaller) to be copied to Column B of results, with the name of the spreadsheet in Column A: Sub copyrows() Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range Dim sht Dim myrange As Range Dim C Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" MyValue = "WhatImLookingFor" For x = 1 To 41 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = Range(C, C.Offset(0, 30)) Else Set CopyRange = Union(CopyRange, Range(C, C.Offset(0, 30))) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "B").End(xlUp).Row + 1 CopyRange.Copy Destination:=Sheets("Results").Range("B" & LastRow) Sheets("Results").Cells(LastRow, 1).Value = sht.Name Set CopyRange = Nothing End If Next End Sub -- Rich Locus Logicwurks, LLC "Rich Locus" wrote: Hello again :) Here's a minor tweak to the code from Mike H that does a Paste Special for values only and doesn't change colors, fonts or anything else: Option Explicit Sub copyrows() Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range Dim sht Dim myrange As Range Dim C ' Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" MyValue = "WhatImLookingFor" For x = 1 To 2 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Sheets("Results").Select Cells(LastRow, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Cells(1, 1).Select Set CopyRange = Nothing End If Next Sheets(1).Select Cells(1, 1).Select End Sub -- Rich Locus Logicwurks, LLC "newlearner01" wrote: Yes, it will be great if we have that addition option. BTW, I would like to add the reference sheet names in the column A, and the copied rows will start from column B of new sheet ("result" in your example) so that we know from where those copied rows come. How can I add sheet names to the Set CopyRange statement? Thanks. "Rich Locus" wrote: Mike: Love the speed of the copy solution for this post. Do you know how to just copy the values and not the formatting? The copy statement in your example copies everything, including formatting and cell colors. Is there a way to copy that works more like a "Paste Special, values only?" -- Rich Locus Logicwurks, LLC "Mike H" wrote: Hi, try this Sub copyrows() Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results" Dim x As Long Dim LastRow As Long Dim MyValue As String Dim CopyRange As Range MyValue = "Somestring" For x = 1 To 41 Set sht = Sheets(x) LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row Set myrange = sht.Range("B1:B" & LastRow) For Each C In myrange If UCase(C.Value) = UCase(MyValue) Then If CopyRange Is Nothing Then Set CopyRange = C.EntireRow Else Set CopyRange = Union(CopyRange, C.EntireRow) End If End If Next If Not CopyRange Is Nothing Then LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1 CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow) Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "newlearner01" wrote: Hi, I am a new in VBA and I am wondering whether someone can help me? My workwork has 45 sheets. I would like to create a macro which will search for string value in the second column ("B") of the first 41 sheets and if it finds the matches it will copy entire row and paste to new sheet in same workbook. Thanks in advance. |
All times are GMT +1. The time now is 10:22 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com