Can you separate a series of numbers by even and odd

Eskonn

New Member
Joined
Mar 28, 2018
Messages
18
I have a large series of numbers that I need separated by even and odd numbers.
Here is what the numbers look like. I have made the odd numbers red on the list below and the even numbers are black

19-11-1
19-11-2
19-11-3
19-11-4
19-12-1
19-12-2
19-12-3
19-12-4
19-13-1
19-13-2
19-13-3
19-13-4
19-14-1
19-14-2
19-14-3
19-14-4

<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>
</tbody>

The digit that determines if it is even or odd is the fourth number 19-14-1
When separating these I would like to separate the whole row.

Any suggestions would be great.
Thanks
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,363
Office Version
  1. 365
Platform
  1. Windows
Assume your data is in column A beginning in Row 1. The following VBA will highlight the Odd numbers in Green Background. I was not sure what you meant by separate. Please clarify. Separate to where? Delete?

Code:
Option Explicit


Sub EvenOdd()
    Dim lr As Long, i As Long, x As Variant
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To lr
        x = Mid(Range("A" & i), 5, 1)
        If x Mod 2 Then
            Range("A" & i).Interior.ColorIndex = 4
        End If
    Next i
End Sub
 
Last edited:

Eskonn

New Member
Joined
Mar 28, 2018
Messages
18
When I import my data the list all comes together. I don't want to delete the odd numbers but would like them in different columns so I can easily sum columns and compare volume of product sold between the even and odd numbers. Hope that made sense.
Below is a better look at how the data comes into excel.
I am trying to compare column F in the example below


A B C D E F G
MaterialSizeVTStorLocationQtyunit
7317515750VT40019-11-15CS
5986815750VT40019-11-28CS
2836015750VT40019-11-39CS
65487157501240019-11-48CS
158971411240019-12-15CS
11134101.75640019-12-23CS
3959157501240019-12-39CS
71173263751240019-12-49CS
5553015750VT40019-13-15CS
6250815750VT40019-13-24CS
7035101.75640019-13-37CS
6738157501240019-13-47CS
2627101.75640019-14-15CS
21971157501240019-14-24CS
10050648750VT40019-14-37CS
100017963VT40019-14-44CS

<colgroup><col width="64" span="7" style="width:48pt"> </colgroup><tbody>
</tbody>



Assume your data is in column A beginning in Row 1. The following VBA will highlight the Odd numbers in Green Background. I was not sure what you meant by separate. Please clarify. Separate to where? Delete?

Code:
Option Explicit


Sub EvenOdd()
    Dim lr As Long, i As Long, x As Variant
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To lr
        x = Mid(Range("A" & i), 5, 1)
        If x Mod 2 Then
            Range("A" & i).Interior.ColorIndex = 4
        End If
    Next i
End Sub
 

Eskonn

New Member
Joined
Mar 28, 2018
Messages
18
Below is an example of how I would like the data to look. Maybe this helps explain better what I am looking for. in the below data column H is blank

MaterialSizeVTStorLocationQtyunitMaterialSizeVTStorLocationQtyunit
7317515750VT40019-11-15CS158971411240019-12-15CS
5986815750VT40019-11-28CS11134101.75640019-12-23CS
2836015750VT40019-11-39CS3959157501240019-12-39CS
65487157501240019-11-48CS71173263751240019-12-49CS
5553015750VT40019-13-15CS2627101.75640019-14-15CS
6250815750VT40019-13-24CS21971157501240019-14-24CS
7035101.75640019-13-37CS10050648750VT40019-14-37CS
6738157501240019-13-47CS100017963VT40019-14-44CS

<colgroup><col span="7"><col><col span="7"></colgroup><tbody>
</tbody>


When I import my data the list all comes together. I don't want to delete the odd numbers but would like them in different columns so I can easily sum columns and compare volume of product sold between the even and odd numbers. Hope that made sense.
Below is a better look at how the data comes into excel.
I am trying to compare column F in the example below


A B C D E F G
MaterialSizeVTStorLocationQtyunit
7317515750VT40019-11-15CS
5986815750VT40019-11-28CS
2836015750VT40019-11-39CS
65487157501240019-11-48CS
158971411240019-12-15CS
11134101.75640019-12-23CS
3959157501240019-12-39CS
71173263751240019-12-49CS
5553015750VT40019-13-15CS
6250815750VT40019-13-24CS
7035101.75640019-13-37CS
6738157501240019-13-47CS
2627101.75640019-14-15CS
21971157501240019-14-24CS
10050648750VT40019-14-37CS
100017963VT40019-14-44CS

<tbody>
</tbody>
 

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,363
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

try this:

Code:
Option Explicit


Sub EvenOdd()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    s1.Range("A1:G1").Copy s2.Range("A1")
    Dim lr As Long, i As Long, x As Variant, lr2 As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    For i = lr To 2 Step -1
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        x = Mid(s1.Range("A" & i), 5, 1)
        If x Mod 2 Then
            s1.Range("A" & i).EntireRow.Copy
            s2.Range("A" & lr2 + 1).PasteSpecial xlPasteValues
            s1.Range("A" & i).EntireRow.Delete
        End If
    Next i
End Sub
 
Last edited:

Eskonn

New Member
Joined
Mar 28, 2018
Messages
18
First, Thank you for your quick reply and trying to help me solve this.
When I ran that it did split the data between 2 sheets which would be excellent. However I am not sure what it used to split the data. There are still even and odds on both sheets. I will post the results below.
Just to make sure I explained correctly in column E I want to split the odd numbers to a new sheet. This is how the number looks 19-11-1. The numbers will always be in this format and the same number of characters. The red number is the number that determines if it is even or odd.

Here is how the list was split between the sheets.
Sheet 1
A B C D E F G
MaterialSizeVTStorLocationQtyunit
5986815750VT40019-11-28CS
2836015750VT40019-11-39CS
11134101.75640019-12-23CS
5553015750VT40019-13-15CS
6250815750VT40019-13-24CS
10050648750VT40019-14-37CS

<colgroup><col width="64" span="7" style="width:48pt"> </colgroup><tbody>
</tbody>

And here is what went to sheet 2
A B C D E F G
MaterialSizeVTStorLocationQtyunit
100017963VT40019-14-44CS
21971157501240019-14-24CS
2627101.75640019-14-15CS
6738157501240019-13-47CS
7035101.75640019-13-37CS
71173263751240019-12-49CS
3959157501240019-12-39CS
158971411240019-12-15CS
65487157501240019-11-48CS
7317515750VT40019-11-15CS

<colgroup><col width="64" span="7" style="width:48pt"> </colgroup><tbody>
</tbody>

Again, thank you for your time

try this:

Code:
Option Explicit


Sub EvenOdd()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    s1.Range("A1:G1").Copy s2.Range("A1")
    Dim lr As Long, i As Long, x As Variant, lr2 As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    For i = lr To 2 Step -1
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        x = Mid(s1.Range("A" & i), 5, 1)
        If x Mod 2 Then
            s1.Range("A" & i).EntireRow.Copy
            s2.Range("A" & lr2 + 1).PasteSpecial xlPasteValues
            s1.Range("A" & i).EntireRow.Delete
        End If
    Next i
End Sub
 

AhoyNC

Well-known Member
Joined
Oct 10, 2011
Messages
4,810
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Here is a formula way.
The formula for the Row # (cells A21 and J21) are array formula and must be entered with CTRL-SHIFT-ENTER then drag down as needed.
Formulas in B21 and J21 just copy down and across.Change ranges to match your data. They can be put on separate worksheets.
Excel Workbook
ABCDEFGHIJKLMNOPQ
1MaterialSizeVTStorLocationQtyunit
27317515750VT40019-11-15CS
35986815750VT40019-11-28CS
42836015750VT40019-11-39CS
565487157501240019-11-48CS
6158971411240019-12-15CS
711134101.75640019-12-23CS
83959157501240019-12-39CS
971173263751240019-12-49CS
105553015750VT40019-13-15CS
116250815750VT40019-13-24CS
127035101.75640019-13-37CS
136738157501240019-13-47CS
142627101.75640019-14-15CS
1521971157501240019-14-24CS
1610050648750VT40019-14-37CS
17100017963VT40019-14-44CS
18
19Even #'sODD #'s
20Row #MaterialSizeVTStorLocationQtyunitRow #MaterialSizeVTStorLocationQtyunit
215158971411240019-12-15CS17317515750VT40019-11-15CS
22611134101.75640019-12-23CS25986815750VT40019-11-28CS
2373959157501240019-12-39CS32836015750VT40019-11-39CS
24871173263751240019-12-49CS465487157501240019-11-48CS
25132627101.75640019-14-15CS95553015750VT40019-13-15CS
261421971157501240019-14-24CS106250815750VT40019-13-24CS
271510050648750VT40019-14-37CS117035101.75640019-13-37CS
2816100017963VT40019-14-44CS126738157501240019-13-47CS
29
Sheet
 

Caleeco

Well-known Member
Joined
Jan 9, 2016
Messages
966
try this:

Code:
Option Explicit


Sub EvenOdd()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    s1.Range("A1:G1").Copy s2.Range("A1")
    Dim lr As Long, i As Long, x As Variant, lr2 As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    For i = lr To 2 Step -1
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        x = Mid(s1.Range("A" & i), 5, 1)
        If x Mod 2 Then
            s1.Range("A" & i).EntireRow.Copy
            s2.Range("A" & lr2 + 1).PasteSpecial xlPasteValues
            s1.Range("A" & i).EntireRow.Delete
        End If
    Next i
End Sub

Not to steal your thunder, but there is a small error in your code. You find the MID for data in column A instead of column E.

This should work:

Code:
Sub EvenOdd()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    s1.Range("A1:G1").Copy s2.Range("A1")
    Dim lr As Long, i As Long, x As Variant, lr2 As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    For i = lr To 2 Step -1
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        x = Mid(s1.Range("E" & i), 5, 1) 'corrected this line
        If x Mod 2 Then
            s1.Range("A" & i).EntireRow.Copy
            s2.Range("A" & lr2 + 1).PasteSpecial xlPasteValues
            s1.Range("A" & i).EntireRow.Delete
        End If
    Next i
End Sub

Hope that helps
Caleeco
 

Eskonn

New Member
Joined
Mar 28, 2018
Messages
18
Yes, that worked!
Thanks for the help.

I have an additional question.
If the data I import has more columns and the location (column E) switches to Column L, What would I need to change in your code to split my data correctly?

Hope that makes sense



Not to steal your thunder, but there is a small error in your code. You find the MID for data in column A instead of column E.

This should work:

Code:
Sub EvenOdd()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    s1.Range("A1:G1").Copy s2.Range("A1")
    Dim lr As Long, i As Long, x As Variant, lr2 As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    For i = lr To 2 Step -1
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        x = Mid(s1.Range("E" & i), 5, 1) 'corrected this line
        If x Mod 2 Then
            s1.Range("A" & i).EntireRow.Copy
            s2.Range("A" & lr2 + 1).PasteSpecial xlPasteValues
            s1.Range("A" & i).EntireRow.Delete
        End If
    Next i
End Sub

Hope that helps
Caleeco
 

Caleeco

Well-known Member
Joined
Jan 9, 2016
Messages
966
No problem, alansidman did all the hard work!

You would just need to change one letter in the line below from this:
Code:
[COLOR=#333333][I]x = Mid(s1.Range("E" & i), 5, 1) 'corrected this line[/I][/COLOR]

to this

Code:
[COLOR=#333333][I]x = Mid(s1.Range("L" & i), 5, 1) 'corrected this line[/I][/COLOR]

Regards
Caleeco

Yes, that worked!
Thanks for the help.

I have an additional question.
If the data I import has more columns and the location (column E) switches to Column L, What would I need to change in your code to split my data correctly?

Hope that makes sense
 

Forum statistics

Threads
1,136,763
Messages
5,677,606
Members
419,706
Latest member
lydytunes13

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top