VBA code for searching a value from table and select first 5 columns of the row containing that value to paste in a different sheet

[Nithi]

Hi all,

I have a list of Reference numbers in column A, I want to search for a specific value by asking user input and select first five columns from the same row if the input matches to cut and paste to the next sheet as top row. I also want to remove other column values from the old sheet. I am very new to VBA coding, so this is the code I have used so far (adapted from a different online source). Please help!!!


Sub Macro5()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LSearchValue As String

On Error GoTo Err_Execute

LSearchValue = InputBox("Please enter the Job Reference Number you wish to move to In Progress:", "Enter value")

'Start search in row 4
LSearchRow = 2

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

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

'If value in column A = LSearchValue, copy first 4 coloumns to InProgress sheet
If Range("A" & CStr(LSearchRow)).Value = LSearchValue Then

'Select row in Sheet1 to copy
Range(CStr(LSearchRow) & "1:" & CStr(LSearchRow)).Select
Selection.Copy

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

'Move counter to next row
LCopyToRow = LCopyToRow + 1

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

End If

LSearchRow = LSearchRow + 1

Wend
Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

 

[JLGWhiz]

See if this will work for you.

Sub t()
Dim c As Range, sh As Worksheet, txt As String, rws As Range
Set sh = ActiveSheet
txt = InputBox("Please enter the Job Reference Number you wish to move to 'In Progress'.", "ENTER JOB REFERENCE")
    If txt = "" Then Exit Sub
    With sh
        For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp)) 'Initialize loop in column A
            If c.Value = txt Then 'test col A values
                c.Resize(1, 5).Copy Sheets("In Progress").Cells(Rows.Count, 1).End(xlUp)(2) 'copy and paste found values
                If IsEmpty(rws) Then 'prep for deletion
                    Set rws = Rows(c.Row)
                Else
                    Set rws = Union(rws & ", " & Rows(c.Row))
                End If
            End If
        Next
    End With
    rws.Delete 'delete moved rows.
End Sub

 

[Nithi]

Hi all,

I have a list of Reference numbers in column A, I want to search for a specific value by asking user input and select first five columns from the same row if the input matches to cut and paste to the next sheet as top row. I also want to remove other column values from the old sheet. I am very new to VBA coding, so this is the code I have used so far (adapted from a different online source). Please help!!!


Sub Macro5()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LSearchValue As String

On Error GoTo Err_Execute

LSearchValue = InputBox("Please enter the Job Reference Number you wish to move to In Progress:", "Enter value")

'Start search in row 4
LSearchRow = 2

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

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

'If value in column A = LSearchValue, copy first 4 coloumns to InProgress sheet
If Range("A" & CStr(LSearchRow)).Value = LSearchValue Then

'Select row in Sheet1 to copy
Range(CStr(LSearchRow) & "1:" & CStr(LSearchRow)).Select
Selection.Copy

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

'Move counter to next row
LCopyToRow = LCopyToRow + 1

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

End If

LSearchRow = LSearchRow + 1

Wend
Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

Figured it out.

Sub MoveToInProgress()

Dim LSearchRow As Integer
Dim LSearchValue As String


On Error GoTo Err_Execute

'Activate the sheet I want to search the data in

Worksheets("Live").Activate


LSearchValue = InputBox("Please enter Reference Number of the job you wish to move to In Progress:", "Enter value")


'Start search in row 4
LSearchRow = 2

'Loop to search data in all rows of column A

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


'If value in column A = LSearchValue, copy first 5 columns to InProgress sheet

If Range("A" & CStr(LSearchRow)).Value = LSearchValue Then


'Insert a row on top in InProgress Sheet to insert the new values
Sheets("InProgress").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow

'Select row in Live sheet to copy
Worksheets("Live").Activate
Range("A" & CStr(LSearchRow) & ":" & "E" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into Sheet2 in next row
Worksheets("InProgress").Activate
Range("A2:E2").Select
ActiveSheet.Paste


'Go back to Sheet1 to Delete the data moved and continue searching
Sheets("Live").Select
Range(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Delete Shift:=xlUp


End If


LSearchRow = LSearchRow + 1


Wend


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


MsgBox "The job has now been moved to In Progress."


Exit Sub


Err_Execute:
MsgBox "An error occurred."


End Sub

 

[Nithi]

Your code is much simpler. Although I am getting an error in the resize line. Not sure why?

 

[JLGWhiz]

Good I had an error in my code. here is the corrected version.

Sub t()
Dim c As Range, sh As Worksheet, txt As String, rws As Range
Set sh = ActiveSheet
txt = InputBox("Please enter the Job Reference Number you wish to move to 'In Progress'.", "ENTER JOB REFERENCE")
    If txt = "" Then Exit Sub
    With sh
        For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp)) 'Initialize loop in column A
            If c.Value = txt Then 'test col A values
                c.Resize(1, 5).Copy Sheets("In Progress").Cells(Rows.Count, 1).End(xlUp)(2) 'copy and paste found values
                If rws Is Nothing Then 'prep for deletion
                    Set rws = Rows(c.Row)
                Else
                    Set rws = Union(rws, Rows(c.Row))
                End If
            End If
        Next
    End With
    rws.Delete 'delete moved rows.
End Sub

 

[Nithi]

Works like a charm! Thanks!

 

[JLGWhiz]

Works like a charm! Thanks!

You're welcome,
Regards, JLG