Hi all
Trying to create a button so it will move rows to another sheet. I have got it to work but only in VB if i run it via a button or run macro it does not work??
I have date in Sheet 1 - if column F has a 1 in this then move the row to Sheet 2.
Various issues.
This works but I have to run this multiple times for all rows where there is a 1 in column F to be moved. (Need a loop to fix this?)
Secondly I would also like it to look for the word REJECT in column X and if this is there then move the entire row.
Please any help I would be grateful. Also again having a working button to do this rather than going into run macro etc
Thanks in advance.
Private Sub CommandButton1_DblClick
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("Survey QA").UsedRange.Rows.Count
B = Worksheets("Move").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Move").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Survey QA").Range("F1:F" & A)
On Error Resume Next
Application.ScreenUpdating = False
For f = 1 To xRg.Count
If CStr(xRg(f).Value) = "1" Then
xRg(f).EntireRow.Copy Destination:=Worksheets("Move").Range("a" & B + 1)
xRg(f).EntireRow.Delete
If CStr(xRg(f).Value) = "1" Then
f = f - 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Trying to create a button so it will move rows to another sheet. I have got it to work but only in VB if i run it via a button or run macro it does not work??
I have date in Sheet 1 - if column F has a 1 in this then move the row to Sheet 2.
Various issues.
This works but I have to run this multiple times for all rows where there is a 1 in column F to be moved. (Need a loop to fix this?)
Secondly I would also like it to look for the word REJECT in column X and if this is there then move the entire row.
Please any help I would be grateful. Also again having a working button to do this rather than going into run macro etc
Thanks in advance.
Private Sub CommandButton1_DblClick
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("Survey QA").UsedRange.Rows.Count
B = Worksheets("Move").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Move").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Survey QA").Range("F1:F" & A)
On Error Resume Next
Application.ScreenUpdating = False
For f = 1 To xRg.Count
If CStr(xRg(f).Value) = "1" Then
xRg(f).EntireRow.Copy Destination:=Worksheets("Move").Range("a" & B + 1)
xRg(f).EntireRow.Delete
If CStr(xRg(f).Value) = "1" Then
f = f - 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub