I found this macro on several websites so I'm not sure who wrote it to give credit where credit is due...but its not working. I'm sure its something I did to mess it up. Can someone please review and tell where the error is?

The gist: I need to be able to check a couple of boxes on the "Start" sheet and have the entire row for the checked wall types (minus the check box and True/False cell if possible) copy to the "End" sheet in consecutive rows. See attached clips for visuals. Here is the VBA code:

Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 3
LSearchRow = 3

'Start copying data to row 3 in "End" Sheet (row counter variable)
LCopyToRow = 3

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



'If value in column K = "TRUE", copy entire row to "End" Sheet
If Range("K" & CStr(LSearchRow)).Value = "TRUE" Then

'Select row in "Start" to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into "End" in next row
Sheets("End").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to "Start" to continue searching
Sheets("Start").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

Attached Images

	Start Sheet.JPG (62.8 KB, 19 views)
	Desired End Sheet.JPG (24.4 KB, 19 views)

HI,

Welcome to the forum.
Can you attach a copy of your workbook? This will help the members with your issue.

Note:

I do not see in the code provided that checks for the "Check" boxes that were selected.

Attached workbook.

Attached Files

Wall Types Test.xlsm (24.8 KB, 8 views)

Oops,

I erred. I see that you have a "True" "False".
Should have looked at your infomation closer.

If you're wanting to know what's wrong so you can fix it, this should be of some assistance.

The While loop is looking for the length of values in the cells of column A and there are no values in column A. Even the check boxes aren't actually in the cells, they are on the cells.

The "TRUE" being looked for in column K doesn't exist. While this isn't an error for Excel, it is for the way you're wanting to use it. The use of the quote marks around true makes it a string and what the check boxes are putting into the cells is Boolean in the form of true and false so the quotes need removed.

The select row to copy... Rows( a number here ) is an entire row, nothing additional needed.

The entire row would be 16,384 cells, and you're wanting to copy 8, so the entire row is a little excessive.
You can specify the range to copy ie: range("B" & the row & ":I" & the row).Copy
and where to paste it, which need only be one cell ie: range("A" & the row) all on one line with no selects or pastes.


If you're looking for someone to fix this for you or suggest some other way, then that's what you need to ask.

I had planned to fix it myself, I just needed a little guidance which you provided. It took a little head scratching to decipher some of what you posted and a little help from the VBA editor...but I got it to work. So again, thank you. Posting the final version here for anyone who might be looking for it.

Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 3
LSearchRow = 3

'Start copying data to row 3 in "End" Sheet (row counter variable)
LCopyToRow = 3

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

'If value in column K = TRUE, copy entire row to "End" Sheet
If Range("K" & CStr(LSearchRow)).Value = True Then

'Select row in "Start" to copy
Range("B" & CStr(LSearchRow) & ":I" & CStr(LSearchRow)).Copy

'Paste row into "End" in next row
Sheets("End").Select
Range("A" & CStr(LCopyToRow)).PasteSpecial

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to "Start" to continue searching
Sheets("Start").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

Hi,

I modified sheet "End" you had Merged cells.
In this copy you will see a "Test" button when you click it the code will set a filter to look for "True" and copy the filtered range to the End sheet.
You will need to clear the "End" sheet other wise the data will be going to the next empty row.
You can modify the code to clear the "End" sheet when you run the code.
Also I have the filter set to range '$K$2:$K$12". This can be modified to include more rows.

Attached Files

Wall Types Test-1.xlsm (28.1 KB, 7 views)