VBA; find string and copy

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