Copy rows to separate sheets based on value in a particular column

Question

The group column in my table contains a value as either 1 or 2 . I want to copy the row with value as 1 to Sheet2 and rows with values as 2 to sheet3 using a button. Also it should show error message if cells are left blank or if value is neither 1 nor 2.

Roll no meter width group

112 150 130 1

Since i am new to coding i have following this approach

check if the cell is empty and generate an error message
check if the cell contains value other than 1 or 2 and generate error message
finally copy the row with values as 1 to Sheet2 and rest all in sheet3

I need help in doing this is an effective way. As i have to keep the size of file down

enter code here

Private Sub CommandButton2_Click()

Dim i As Integer

p = Sheet1.Range("l1").Value 'no. of filled cells in the range
Application.DisplayAlerts = False
Sheet1.Activate
    ''checking if the range is empty
    For i = 29 To p + 29
        If Sheet1.Range("l" & i).Value = "" Then
        MsgBox ("PLEASE ENTER THE SHRINKAGE GROUP FOR CELL NO. l" & i)
        Range("L" & i).Activate
        End
        End If
        Next i
    '' checking if the range contains values other than 1 or 2

    For i = 29 To p + 29
        If Sheet1.Range("l" & i).Value <> 1 And Sheet1.Range("l" & i).Value <> 2 Then
        MsgBox ("SHADE GROUP DOES NOT EXIST FOR CELL NO. l" & i)

        Range("L" & i).Activate
        End
        End If
        Next i

' sort based on the group

Range("a29:L300").Sort _
Key1:=Range("l29"), Header:=xlYes

'count the number of rolls in group 1
Dim x, y As Long
Dim a, b As Integer
x = Range("L" & Rows.Count).End(xlUp).Row
If x < 29 Then x = 29
a = Application.WorksheetFunction.CountIf(Range("L12:L" & x), 1) + 28
Range("M1").Value = a

' count the number of rolls in group 2
y = Range("L" & Rows.Count).End(xlUp).Row
If y < 29 Then y = 29
b = Application.WorksheetFunction.CountIf(Range("L12:L" & x), 2)
Range("n1").Value = b

'' copying groupwise to different sheet
Sheet1.Range("a29", "l" & a).Copy
Sheet2.Range("a5").PasteSpecial xlPasteAll
Sheet2.Range("a5").PasteSpecial xlPasteValuesAndNumberFormats
'' copying group 2
Sheet1.Range("a" & a + 1, "l" & a + b).Copy
Sheet5.Range("a5").PasteSpecial xlPasteAll
Sheet5.Range("a5").PasteSpecial xlPasteValuesAndNumberFormats

End Sub

This sounds like a problem that's better suited to data validation and formulae than VBA, but could you show us the code you've tried so far? — jsheeran
i have attached the code. i hope it will make things clearer. — jhonty

jsheeran jsheeran · Accepted Answer · 2016-04-25T13:10:27

Create named ranges for your source data and for the rows after which you want it to be copied. In this example I've used "source", "range1" and "range2". Then the following code copies the source data into the appropriate place:

Sub copyData()
    Dim source As Range, range1 As Range, range2 As Range
    Dim r As Range
    Set source = Range("source")
    Set range1 = Range("range1")
    Set range2 = Range("range2")
    For Each r In source.Rows
        If r.Cells(1, 4).Value = 1 Then
            copyRow r, range1
        ElseIf r.Cells(1, 4).Value = 2 Then
            copyRow r, range2
        Else
            ' handle error here
        End If
    Next r
End Sub

Sub copyRow(data As Range, targetRange As Range)
    Set targetRange = targetRange.Resize(targetRange.Rows.Count + 1, targetRange.Columns.Count)
    For i = 1 To 3
        targetRange.Cells(targetRange.Rows.Count, i).Value = data.Cells(1, i).Value
    Next i
End Sub

There's probably a much more elegant way of doing this involving array formulae, but this should do the trick.

For validating that each cell contains only "1" or "2", you can include additional code where I've put a comment, but you'd be better off handling this as a data validation.

Copy rows to separate sheets based on value in a particular column

1 Answers