VBA; find string and copy

**Bill Rudd** · 02-01-2008, 03:54 AM

I think I am making progress, and thank you for the great search box! The 'Dim LSearchRow' and Dim LCoptToRow' rows I have changed from the 'As Integer' to 'As String' (my own guess, and I haven't been able to test it yet.

My real question is in lines (14) and (15); the code that I copied from the web has me searching for a set variable. How do I get the program to search for my 'String'?
[code]

(1) Sub box1()

(2) On Error GoTo Err_Execute

(3) Sub findString()
(4) Dim sFind As String

(5) sFind = Application.InputBox("Enter the search string", "Search...")
(6) If sFind > "" Then

(7) Dim LSearchRow As String
(8) Dim LCopyToRow As String

(9) 'Start search in row 2
(10) LSearchRow = 2

(11) 'Start copying data to row 2 in Sheet2 (row counter variable)
(12) LCopyToRow = 2

(13) While Len(Range("A" & CStr(LSearchRow)).Value) > 0

(14) 'If value in column B = "CAT", copy entire row to Sheet2
(15) If Range("B" & CStr(LSearchRow)).Value = "CAT" Then

(16) 'Select row in Sheet1 to copy
(17) Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
(18) Selection.Copy[code]

Yours Sincerely,
Bill Rudd

**Bill Rudd** · 02-13-2008, 02:49 AM

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

**royUK** · 02-13-2008, 05:24 AM

You can adjust the sheet numbers & column numbers in this to suit your needs

Option Explicit

Private Sub Workbook_Open()
    Dim rCopy  As Range
    Dim i      As Integer
    i = 2  'sheet to start from
    Do While i < 6
        With Worksheets(i)
            'copy cells with values in Column A
            Set rCopy = .Columns(1).SpecialCells(xlCellTypeConstants)
            rCopy.Copy Worksheets(3).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
        i = i + 1
    Loop
End Sub

**Bill Rudd** · 02-18-2008, 03:16 AM

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

**Bill Rudd** · 02-18-2008, 03:44 AM

Nevermind,

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

Yours Truly,
Bill Rudd

**Bill Rudd** · 02-20-2008, 10:31 PM

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

**Bill Rudd** · 02-26-2008, 08:27 PM

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