CODEWITHSUNDEEP
excelvba
Natália Gomes
Natália Gomes

Reputation: 1

Copy in different columns what is even and odd separating by ":"

I have the follow code: A106:A107:A110:A111:A112:A113:A118:A119

I would like to get an answer in two different columns: Even and odd.

Example: A106:A110:A112:A118 and A107:A111:A113:A119.

Could anybody give me a tip of what to do it automatic?

Upvotes: 0

Views: 111

Answers (2)

Jeremy
Jeremy

Reputation: 1337

This would do it:

Sub Test()
Dim sPart, sFull As String
Dim WS1, WS2 As Worksheet
Dim i As Long

Set WS1 = ActiveSheet
sFull = "A106:A107:A110:A111:A112:A113:A118:A119"
Sheets.Add After:=Sheets(Sheets.Count)
Set WS2 = ActiveSheet

WS2.Range("A1").Value = "Odd"
WS2.Range("B1").Value = "Even"

Do While InStr(sFull, ":")
    sPart = Left(sFull, InStr(sFull, ":"))
    i = Mid(sPart, 2, Len(sPart) - 2)
    If i Mod 2 <> 0 Then
        WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1).Value = Left(sPart, Len(sPart) - 1)
        Else
        WS2.Range("B" & WS2.Rows.Count).End(xlUp).Offset(1).Value = Left(sPart, Len(sPart) - 1)
    End If
    sFull = Right(sFull, Len(sFull) - Len(sPart))
Loop

sPart = sFull
i = Mid(sPart, 2, Len(sPart) - 1)
If i Mod 2 <> 0 Then
    WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1).Value = Left(sPart, Len(sPart) - 1)
    Else
    WS2.Range("B" & WS2.Rows.Count).End(xlUp).Offset(1).Value = Left(sPart, Len(sPart) - 1)
End If

End Sub

Upvotes: 0

ttaaoossuu
ttaaoossuu

Reputation: 7884

Try this VBA function:

Public Function ExtractOdds(Data As String, Delimiter As String, IsOdd As Boolean) As String
    Dim Elements() As String
    Dim Result As String

    Elements = Split(Data, Delimiter)

    For Each Item In Elements
        If Right(Item, 1) Mod 2 = -IsOdd Then
            If Len(Result) > 0 Then
                Result = Result & Delimiter
            End If
            Result = Result & Item
        End If
    Next Item

    ExtractOdds = Result
End Function

Usage to extract odd values:

=ExtractOdds(A1,":",TRUE)

Usage to extract even values:

=ExtractOdds(A1,":",FALSE)

Upvotes: 2

Related Questions