How to copy data from a row if a certain value is present in column, using VBA? - vba

Question

I've been working on a spreadsheet to help with reporting and I'm stumped on the final element. Essentially, if column G of a worksheet contains a certain text string, I want to copy the appropriate row to another worksheet under the existing data in that sheet.
After two hours of googling I've tried various solutions but haven't been able to configure one to do what I want it to. Currently I'm working with the below:
Dim x As Integer
Dim Thisvalue As String
Dim NextRow As Range
Sheets("Week 4").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column D
Thisvalue = Cells(x, 7).Value
If Thisvalue = "Customer placed on hold" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("Retained data").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Week 4").Select
End If
Next x
End Sub
However, I think I'm on the wrong track and in all honesty I've forgotten so much about VBA that I'm essentially starting from scratch again as far as my knowledge goes. Any help would be greatly appreciated!

Answer 1

The code below will loop throug all cells in Column G (until FinalRow), and check for value "Customer placed on hold". When it finds, it copies the entire row to the next avaialble row at "Retained data" worksheet.
Note: it's better to avoid using Select and ActiveSheet as they might change according to your current ActiveSheet. Instead it's better to use referenced Sheet objects, .Cells and Ranges.
Code
Option Explicit
Sub CopyRow()
Dim x As Long
Dim Thisvalue As String
Dim NextRow As Long
Dim FinalRow As Long
With Sheets("Week 4")
' Find the last row of data in Column A
FinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column G
If .Cells(x, 7).Value = "Customer placed on hold" Then
' Find the last row of data
NextRow = Sheets("Retained data").Cells(Sheets("Retained data").Rows.Count, 1).End(xlUp).Row
' copy > paste in 1 line
.Cells(x, 7).EntireRow.Copy Sheets("Retained data").Range("A" & NextRow + 1)
End If
Next x
End With
End Sub

Answer 2

Try this one:
Sub Makro2()
Dim x As Integer
Dim Thisvalue As String
Sheets("Week 4").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column D
Thisvalue = Cells(x, 7).Value
If Thisvalue = "Customer placed on hold" Then
Range(Cells(x, 1), Cells(x, 33)).Copy
With Sheets("Retained data")
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial xlPasteAll
End With
End If
Next x
End Sub

Answer 3

since you want to check column "G" values against a string ("Customer placed on hold") then you want to avoid looping through column "A" cells and loop through "string" cells of columns "G" only
then you can avoid looping through all cells and just Find() the wanted ones:
Sub CopyRow()
Dim firstAddress As String
Dim f As Range
With Worksheets("Week 4") '<--| reference your relevant worksheet
With .Range("G2", .Cells(.Rows.COUNT, "G").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through its column G "string" values only
Set f = .Find(what:="Customer placed on hold", lookat:=xlWhole, LookIn:=xlValues, after:=.Areas(.Areas.COUNT).Cells(.Areas(.Areas.COUNT).COUNT)) '<--| search for wanted string in referenced range, starting from the cell after its last cell (i.e.: the first cell)
If Not f Is Nothing Then '<--| if found
firstAddress = f.Address '<--| store its address to stop 'Find()' loop at its wrapping back to the first found cell
Do
With Worksheets("Retained data") '<--| reference target sheet
f.EntireRow.Copy .Cells(.Rows.COUNT, 1).End(xlUp).Offset(1) '<--| copy found cell entire row into last referenced worksheet first not empty cell
End With
Set f = .FindNext(f) '<--| find next cell matching wanted value
Loop While f.Address <> firstAddress '<--| exit loop when it wraps back to first found cell
End If
End With
End With
End Sub
should your column "G" data extend beyond actual range of column "A" data, and you be interested in limiting the range to this latter, then you just have to change:
With .Range("G2", .Cells(.Rows.COUNT, "G").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through its column G "string" values only
to
With Intersect(.Range("A2", .Cells(.Rows.COUNT, "A").End(xlUp)).EntireRow, .Range("G2", .Cells(.Rows.COUNT, "G").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues)) '<--| loop through its column G "string" values only down to its column "A" last not empty row