Writing a macro for sorting purposes

Last Edited By Krjb Donovan
Last Updated: Mar 05, 2014 10:04 PM GMT

Question

! I'd like to create a macro that will sort my data and move the entire row to a different worksheet within the workbook based on the entry in column A (a mixture of numbers and letters). For example:

"Master Sheet" Column A Column B 12345 Green a12345 Red b12345 Yellow c12345 Purple 1234x Red 00123 Yellow 2345x Green

What I would like to see: -if the entry has 5 digits or starts with an A, I'd like to move the entries to an existing "Sheet 1" -if the entry starts with a B, I'd like to move it to an existing "Sheet 2"; if it starts with a C, I'd like to move it to an existing "sheet 3" -if the entry ends with the letter "x", I'd like to delete the entire row.

I don't know if this complicates it, but some of the column A entries are in text format, while others in number format.


Answer

Irma,

The following worked for me using your data to test. I assume that your sheets are named

Master Sheet 1 Sheet 2 Sheet 3

in no particulare order. Also, since all data in Master is deleted at the end of the macro, I don't do anything with the values that end in x. If a value begins with an "A", "B", "C" (case insensitive), I use the stated destination for that - I don't check if it also has an "x" on the end (I assume that the leading character takes precedence or that this will not happen).

Sub MoveData() Dim sh As Worksheet Dim cell As Range, r As Range Dim s As String, r1 as Range Set sh = Worksheets("Master") Set r = sh.Range("A1", sh.Cells(sh.Rows.Count, "A").End(xlUp)) For Each cell In r

 s = UCase(cell.Text)
 If (IsNumeric(s) And Len(s) = 5) Or Left(s, 1) = "A" Then
     With Worksheets("Sheet 1")
        Set r1 = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
     End With
     cell.EntireRow.Copy r1
 ElseIf Left(s, 1) = "B" Then
     With Worksheets("Sheet 2")
        Set r1 = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
     End With
     cell.EntireRow.Copy r1
 ElseIf Left(s, 1) = "C" Then
     With Worksheets("Sheet 3")
        Set r1 = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
     End With
     cell.EntireRow.Copy r1
 End If

Next ' now delete all the data on sheet "Master" (definition of MOVE vice COPY) r.EntireRow.Delete End Sub

Advertisement

©2021 eLuminary LLC. All rights reserved.