View Single Post
 
Old 06-12-2015, 07:45 AM
BIMwit BIMwit is offline Windows 7 64bit Office 2013
Novice
 
Join Date: May 2015
Posts: 4
BIMwit is on a distinguished road
Default Someone please check my macro

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
File Type: jpg Start Sheet.JPG (62.8 KB, 21 views)
File Type: jpg Desired End Sheet.JPG (24.4 KB, 21 views)
Reply With Quote