VBA; find string and copy

It's nice to meet you,

My name is Bill Rudd, I'm new to VBA but would like to finish my first project.

I would like to call up a find box, then be able to search several worksheets for a string, to copy and paste the related row to a new worksheet.

I've gotten as far as being able to search for a string and get the row pasted, as long as the string is defined in my macro. Is there a way though to be able to call up a find box first though, and search for the input variable? (alternatively, I can only imagine a separate piece of code for each variable, of which there are many, and I am actually trying to save time... )

Is there someone that can point me in the right direction, I would be very obliged.

Yours Truly,
Bill

Thank you for the quick help last night, I am testing this now.

Yours Truly,
Bill Rudd

Hi guys, thanks for the previous help, and help on other forums here.

I am starting from scratch, and have written some very simple working code.

The first step to get this project to work is, (probably simple), an initial macro.

Step 1: It should run automatically when the workbook is opened
Step 2: It should search a column on Sheet 2. Some values will be empty, others will have values.
Step 3: Any empty cells should be ignored.
Step 4: Any cells with values should be copied to Sheet 10. (In an increasing column)
Step 5: When Sheet 2 has been checked, the process should be repeated for sheet 3, sheet 4, and sheet 5.

I'm guessing this is very easy. Can you help?

Yours Earnestly,
Bill Rudd

Dear Roy, and others,

Thank you for the help. With some modifications, I am getting the result for step one that I was hoping for.

I am having a new challenge that may not be related to the macro exactly, possibly a general excel question.

I am trying to name the column of data that was the output from the macro. Other named ranges in the workbook can be referred to by a drop down box without problem. However, when I tie the drop-down box to the range of data created by the macro, with Data>Validation, the drop-down box just gives me a single blank line.

Any insight you guys?

Yours Truly,
Bill Rudd

Nevermind,

I didn't figure out the problem, but solved the symptom. Let me save my questions for later.

Yours Truly,
Bill Rudd

OK, I am pretty proud of how this is turning out so far. Anyway, it's working.

This part of the code is what I am using to search target columns and copy target cells, for specified worksheets. I'd like to start searching though from row 3 down. Can I insert something simple to do the trick?

Yours Truly,
Bill Rudd
----------

'Search Series Data "IEC wuxi"

Sheets("IEC wuxi").Select

Do

With Worksheets("IEC wuxi")
'copy cells with values in Column B
Set rCopy = .Columns(2).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

Cells(1000, 2).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

Thank you guys for the earlier help. I just want to say that my first macro is working; anyway, it is getting the result that I wanted. It's a bit slow, and I have it repeating a bunch of commands that could probably be consolidated. Happy though.

The macro runs automatically when the document is opened. It searches relevant worksheets, and copies them to a data collection worksheet. Data is filtered for repeats and alphabetized. The resulting three columns of data are then named as ranges (not by the macro), then used as drop-down lists.

The second and final macro will take the value selected in one of the drop down boxes, then use it to search the workbook for matching occurrences, then copy target cells from the corresponding row to a data output worksheet. Lastly, I will try to have dates for each search target evaluated (these are certifications), for an output of 'current', 'applied', 'expired'. Having problems, of course, but hope to finish soon.

Anyway, thanks for all the help so far, and for letting me copy your code.

----------------------

Sub Auto_Open()

Dim rCopy As Range


'Search Series Data "IEC wuxi"

Sheets("IEC wuxi").Select

Do

With Worksheets("IEC wuxi")

'copy cells with values in Column B
Set rCopy = .Columns(2).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

'Check row 1000, column 2 for a value; if empty, then proceed to next worksheet.
'This means that the search is only good for 999 items, and this cell should be left blank.

Cells(1000, 2).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Series Data "TUV wuxi"

Sheets("TUV wuxi").Select

Do

With Worksheets("TUV wuxi")

'copy cells with values in Column A
Set rCopy = .Columns(1).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

Cells(1000, 2).Select

If ActiveCell = ("") Then Exit Do

End With

Loop


'Search Series Data "TUV qinghai"

Sheets("TUV qinghai").Select

Do

With Worksheets("TUV qinghai")

'copy cells with values in Column B
Set rCopy = .Columns(2).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

Cells(1000, 2).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'search series data "UL wuxi"

Sheets("UL wuxi").Select

Do

With Worksheets("UL wuxi")

'copy cells with values in Column B
Set rCopy = .Columns(2).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

Cells(1000, 2).Select

If ActiveCell = ("") Then Exit Do

End With

Loop


'Search Products Data "IEC wuxi" Column "C"

Do

With Worksheets("IEC wuxi")
'copy cells with values in Column C
Set rCopy = .Columns(3).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop


'Search Products Data "TUV wuxi" Column "B"

Do

With Worksheets("TUV wuxi")
'copy cells with values in Column B
Set rCopy = .Columns(2).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Products Data "TUV wuxi" Column "C"

Do

With Worksheets("TUV wuxi")
'copy cells with values in Column C
Set rCopy = .Columns(3).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Products Data "TUV qinghai" Column "D"

Do

With Worksheets("TUV qinghai")
'copy cells with values in Column D
Set rCopy = .Columns(4).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Products Data "TUV qinghai" Column "C"

Do

With Worksheets("TUV qinghai")
'copy cells with values in Column C
Set rCopy = .Columns(3).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Products Data "UL wuxi" Column "C"

Do

With Worksheets("UL wuxi")
'copy cells with values in Column C
Set rCopy = .Columns(3).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Products Data "junction box" Column "B"

Do

With Worksheets("junction box")
'copy cells with values in Column B
Set rCopy = .Columns(2).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Products Data "MSK IEC" Column "B"

Do

With Worksheets("MSK IEC")
'copy cells with values in Column B
Set rCopy = .Columns(2).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop


'Search Products Data "MSK JET" Column "B"

Do

With Worksheets("MSK JET")
'copy cells with values in Column B
Set rCopy = .Columns(2).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Products Data "MSK UL" Column "B"

Do

With Worksheets("MSK UL")
'copy cells with values in Column B
Set rCopy = .Columns(2).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop


'Search Certification Data "IEC wuxi" Column "F"

Do

With Worksheets("IEC wuxi")
'copy cells with values in Column F
Set rCopy = .Columns(6).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Certification Data "TUV wuxi" Column "G"

Do

With Worksheets("TUV wuxi")
'copy cells with values in Column G
Set rCopy = .Columns(7).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Certification Data "TUV qinghai" Column "H"

Do

With Worksheets("TUV qinghai")
'copy cells with values in Column H
Set rCopy = .Columns(8).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Certification Data "UL wuxi" Column "F"

Do

With Worksheets("UL wuxi")
'copy cells with values in Column F
Set rCopy = .Columns(6).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Certification Data "junction box" Column "D"

Do

With Worksheets("junction box")
'copy cells with values in Column D
Set rCopy = .Columns(4).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop


'Search Certification Data "MSK IEC" Column "F"

Do

With Worksheets("MSK IEC")
'copy cells with values in Column F
Set rCopy = .Columns(6).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop


'Search Certification Data "MSK JET" Column "F"

Do

With Worksheets("MSK JET")
'copy cells with values in Column F
Set rCopy = .Columns(6).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop

'Search Certification Data "MSK UL" Column "D"

Do

With Worksheets("MSK UL")
'copy cells with values in Column D
Set rCopy = .Columns(4).SpecialCells(xlCellTypeConstants)
rCopy.Copy Worksheets("search data").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

Cells(1000, 3).Select

If ActiveCell = ("") Then Exit Do

End With

Loop



' Alphabatize Macro
' Macro recorded 2008/2/20 by william
'

'

Sheets("search data").Select

Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Columns("B:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Columns("C:C").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal


'delete specific column titles, won't work if column titles are changed again later.
'this is sloppy, and very picky about unseen spaces, etc.


Sheets("search data").Select

'Check column A for "series of Product"
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 1).Value) = ("series of Product ") Then
Cells(i, 1).Delete
End If

Next i

Sheets("search data").Select

'Check column A for "series of Product"
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 1).Value) = ("series of Product ") Then
Cells(i, 1).Delete
End If

Next i

Sheets("search data").Select

'Check column A for "series of Product"
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 1).Value) = ("series of Product ") Then
Cells(i, 1).Delete
End If

Next i

'Check column B for static column headers and delete

'Check column B for "juction box style"
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 2).Value) = ("juction box style") Then
Cells(i, 2).Delete
End If

Next i

'Check column B for "Module Type"
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 2).Value) = ("Module Type") Then
Cells(i, 2).Delete
End If

Next i

'Check column B for "Modules Type"
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 2).Value) = ("Modules Type") Then
Cells(i, 2).Delete
End If

Next i

'Check column B for "Modules Type"
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 2).Value) = ("Modules Type") Then
Cells(i, 2).Delete
End If

Next i

'Check column B for "Modules Type"
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 2).Value) = ("Modules Type") Then
Cells(i, 2).Delete
End If

Next i

'Check column C for specific uneeded values (column headers)

'Check column C for "test standard"
iLastRow = Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 3).Value) = ("test standard") Then
Cells(i, 3).Delete
End If

Next i

'Check column C for "test standard"
iLastRow = Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 3).Value) = ("test standard") Then
Cells(i, 3).Delete
End If

Next i

'Check column C for "Fire Class"
iLastRow = Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 3).Value) = ("Fire Class") Then
Cells(i, 3).Delete
End If

Next i


'Check column C for "Edition of test standard"
iLastRow = Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 3).Value) = ("Edition of test standard") Then
Cells(i, 3).Delete
End If

Next i


'Check column C for "Edition of test standard"
iLastRow = Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 3).Value) = ("Edition of test standard") Then
Cells(i, 3).Delete
End If

Next i


'Check column C for "Edition of test standard"
iLastRow = Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To iLastRow

If (Cells(i, 3).Value) = ("Edition of test standard") Then
Cells(i, 3).Delete
End If

Next i

'Shorten List

Qq = Application.CountA(ActiveSheet.Range("C:C")) 'Get row count before beginning
For uY = 1 To 6 'Spin thru 6 times to get them all
For oZ = 2 To Qq 'Main loop
If Cells(oZ, 3) = Cells(oZ - 1, 3) Then 'Check for dups
Cells(oZ, 3).Select 'Select the cell
Selection.Delete Shift:=xlUp 'Delete
Qq = Qq - 1 'Change loop criteria because cell gone
End If 'End
Next 'Inside loop
Next 'Outside loop

Qq = Application.CountA(ActiveSheet.Range("C:C")) 'Get row count before beginning
For uY = 1 To 6 'Spin thru 6 times to get them all
For oZ = 2 To Qq 'Main loop
If Cells(oZ, 3) = Cells(oZ - 1, 3) Then 'Check for dups
Cells(oZ, 3).Select 'Select the cell
Selection.Delete Shift:=xlUp 'Delete
Qq = Qq - 1 'Change loop criteria because cell gone
End If 'End
Next 'Inside loop
Next 'Outside loop

Qq = Application.CountA(ActiveSheet.Range("C:C")) 'Get row count before beginning
For uY = 1 To 6 'Spin thru 6 times to get them all
For oZ = 2 To Qq 'Main loop
If Cells(oZ, 3) = Cells(oZ - 1, 3) Then 'Check for dups
Cells(oZ, 3).Select 'Select the cell
Selection.Delete Shift:=xlUp 'Delete
Qq = Qq - 1 'Change loop criteria because cell gone
End If 'End
Next 'Inside loop
Next 'Outside loop

Qq = Application.CountA(ActiveSheet.Range("C:C")) 'Get row count before beginning
For uY = 1 To 6 'Spin thru 6 times to get them all
For oZ = 2 To Qq 'Main loop
If Cells(oZ, 3) = Cells(oZ - 1, 3) Then 'Check for dups
Cells(oZ, 3).Select 'Select the cell
Selection.Delete Shift:=xlUp 'Delete
Qq = Qq - 1 'Change loop criteria because cell gone
End If 'End
Next 'Inside loop
Next 'Outside loop


Qq = Application.CountA(ActiveSheet.Range("C:C")) 'Get row count before beginning
For uY = 1 To 6 'Spin thru 6 times to get them all
For oZ = 2 To Qq 'Main loop
If Cells(oZ, 3) = Cells(oZ - 1, 3) Then 'Check for dups
Cells(oZ, 3).Select 'Select the cell
Selection.Delete Shift:=xlUp 'Delete
Qq = Qq - 1 'Change loop criteria because cell gone
End If 'End
Next 'Inside loop
Next 'Outside loop

'return to search screen

Sheets("Search Product").Select




End Sub

Dear Xcellent advisors,

This program is using a variable defined by the user from a drop-down list to identify a target row on another worksheet.

If the variable is present, there are no problems. But I am getting an 'Object variable or With block variable not set' error. The internet seems to want me to define the variable as an object and to add 'Set'. I don't know that I want it to be an object though? Isn't it just a value?

Please help!

---------------

'start search based on series (zcell) here

'Find variable in 'series' input cell

Cells(10, 4).Select

zcell = ActiveCell.Value

'Start search by series on "IEC wuxi" worksheet; no loop assumes one occurence per page

Sheets("IEC wuxi").Select

'GETTING ERROR IF VARIABLE NOT PRESENT ON SHEET


'find variable somewhere on active sheet
Cells.Find(What:=zcell, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False).Select


'Find required corresponding certification and copy
SerRow = ActiveCell.Row

Cells(SerRow, 6).Select

Selection.Copy

'select data output page and paste to next available empty row

Sheets("Search Product").Select

Range("H13").Select

varnbrows = ActiveCell.Rows.Count
ActiveCell.Offset(varnbrows, 0).Select

ActiveSheet.Paste

Selection.Interior.ColorIndex = 34
Selection.Interior.ColorIndex = 34
Selection.Font.ColorIndex = 1
Selection.Font.ColorIndex = 1

I cleaned up the macro to search all worksheets (sorry for the mess earlier, again, I am brand new at this)

The below code searches all worksheet in the workbook for values in column "B", then copies them to Column "A" on the data output sheet.

I need to get it to skip one of the worksheets though. In order, "data", "search", "IEC wuxi", "TUV wuxi", etc; and need to jump over ws "search".

I've tried some If-Thens, a GoTo and throwing in an extra 'Goto next wSheet'. I keep getting errors though, my grammar just isn't good enough. Can you someone help one last time?

-------------------------

Sub Auto_Open()

Dim wSheet As Worksheet

Application.ScreenUpdating = False

Set wSheet = ActiveSheet

For Each wSheet In Worksheets


'GET IT TO SKIP "search" HERE:


'Check all sheets "B" and paste to data!"A"

With wSheet

BRows = .Range("B65536").End(xlUp).Row 'LAST CELL USED IN A
COLUMN
intCols = .Range("A1").End(xlToLeft).Column 'THIS IS LAST CELL USED
IN "ROW 1"; NOT USED

Set rngToCopy = .Range(.Cells(2, 2), .Cells(BRows,
2)).SpecialCells(xlCellTypeVisible)
rngToCopy.Copy
Worksheets("data").Range("A65536").End(xlUp).Offset(1,
0).PasteSpecial xlPasteValues

End With

'END SKIP "search" HERE:


Next wSheet

Sheets("data").Select

-----------------

Yours Wretchedly,
BR

Hi Bill,

Let me know if putting this line of code...

Please Login or Register  to view this content.

...here: 'GET IT TO SKIP "search" HERE:" and this line...

Please Login or Register  to view this content.

...here: 'END SKIP "search" HERE:

does the trick.

HTH

Robert