Macro to move row of data to new sheet based on cell value

[Garrek]

I have a sheet of data called "MasterData", and two more sheets named both "Dedicated" and "OneWay". I would like to have a macro that moved rows of data from MasterData to Dedicated or OneWay based on a value in column C. That value would match the sheet name, so if column C contains "OneWay" I would like the row (A:Q) to be moved to the OneWay sheet, and same for Dedicated. Ideally, I would leave the data untouched on MasterData as well, so it does not delete after sorting through this. Any suggestions?

 

[vcoolio]

Hello Garrek,

Perhaps you could create drop down lists in each cell in Column C of your dataset with the criteria then use the following Worksheet_Change event code:-

Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)

        If Intersect(Target, Columns(3)) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub

Application.ScreenUpdating = False

        If Target.Value = "Dedicated" Or Target.Value = "OneWay" Then
        Target.EntireRow.Copy Sheets(Target.Value).Range("A" & Rows.Count).End(3)(2)
        End If

Application.ScreenUpdating = True

End Sub

Each time a criteria is selected the relevant row of data will be immediately transferred to its corresponding worksheet. No buttons required.

To implement this code:-

- Right click on the MasterData tab.
- Select "View Code" from the menu that appears.
- Paste the above code into the big white code field that then appears.

I hope that this helps.

Cheerio,
vcoolio.

 

[Garrek]

Hello Garrek,

Perhaps you could create drop down lists in each cell in Column C of your dataset with the criteria then use the following Worksheet_Change event code:-

Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)

        If Intersect(Target, Columns(3)) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub

Application.ScreenUpdating = False

        If Target.Value = "Dedicated" Or Target.Value = "OneWay" Then
        Target.EntireRow.Copy Sheets(Target.Value).Range("A" & Rows.Count).End(3)(2)
        End If

Application.ScreenUpdating = True

End Sub

Each time a criteria is selected the relevant row of data will be immediately transferred to its corresponding worksheet. No buttons required.

To implement this code:-

- Right click on the MasterData tab.
- Select "View Code" from the menu that appears.
- Paste the above code into the big white code field that then appears.

I hope that this helps.

Cheerio,
vcoolio.

Unfortunately the problem I run into with this is that the data on MasterData is being copied and pasted into it. This worked for me when I typed OneWay or Dedicated into column C, but when pasting it didn't function unfortunately.

 

[vcoolio]

Hello Garrek,

I see. Try the following code instead, assigned to a button:-

Option Explicit

Sub Garrek()

        Dim wsMD As Worksheet: Set wsMD = Sheets("MasterData")
        Dim ar As Variant: ar = Array("Dedicated", "OneWay")
        Dim i As Long
        
Application.ScreenUpdating = False

        For i = 0 To UBound(ar)
                Sheets(ar(i)).UsedRange.Offset(1).Clear
                With wsMD.[A1].CurrentRegion
                        .AutoFilter 3, ar(i)
                        .Offset(1).EntireRow.Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
                        .AutoFilter
                End With
        Next i

Application.ScreenUpdating = True

End Sub

I'm assuming that your data starts in Row2 with headings in Row1.

I hope that this helps.

Cheerio,
vcoolio.

 

[Garrek]

Hello Garrek,

I see. Try the following code instead, assigned to a button:-

Option Explicit

Sub Garrek()

        Dim wsMD As Worksheet: Set wsMD = Sheets("MasterData")
        Dim ar As Variant: ar = Array("Dedicated", "OneWay")
        Dim i As Long
       
Application.ScreenUpdating = False

        For i = 0 To UBound(ar)
                Sheets(ar(i)).UsedRange.Offset(1).Clear
                With wsMD.[A1].CurrentRegion
                        .AutoFilter 3, ar(i)
                        .Offset(1).EntireRow.Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
                        .AutoFilter
                End With
        Next i

Application.ScreenUpdating = True

End Sub

I'm assuming that your data starts in Row2 with headings in Row1.

I hope that this helps.

Cheerio,
vcoolio.

Perfect, Thank you!!!!!!!!

 

[vcoolio]

You're welcome Garrek. I'm glad to have been able to assist.

Cheerio,
vcoolio.