Extract Remaining text from cells

  • Hi, I'm looking for help with extracting a single letter from cells, Col B2 (B1 & C1 are headers). In the example below the extracted data is in column C and is taken from every cell in column B that has a letter "D" in that range. (Can be left or right of letter D), the actual search letter will come from another cell (H2). Note there are no blanks in the extracted data (Col C). I have tried over a week to no avail. Thanks in advance.
    [TABLE="border: 2, cellpadding: 1, width: 100"]

    [tr]


    [td]

    Col B

    [/td]


    [td]

    Col C

    [/td]


    [/tr]


    [tr]


    [td]

    AD

    [/td]


    [td]

    A

    [/td]


    [/tr]


    [tr]


    [td]

    FG

    [/td]


    [td]

    F

    [/td]


    [/tr]


    [tr]


    [td]

    RT

    [/td]


    [td]

    S

    [/td]


    [/tr]


    [tr]


    [td]

    DF

    [/td]


    [td][/td]


    [/tr]


    [tr]


    [td]

    ER

    [/td]


    [td][/td]


    [/tr]


    [tr]


    [td]

    SD

    [/td]


    [td][/td]


    [/tr]


    [tr]


    [td]

    AE

    [/td]


    [td][/td]


    [/tr]


    [/TABLE]

  • Hi there,


    As long as there's only two letters in each cell down column B this will do the job:



    Just make sure you run the code while on the sheet with the data.


    Regards,


    Robert

  • Works Perfetctly!! I noticed there were random "spaces" between the 2 letters in my column but the code still worked...... Thanks very much!! :congrats:


    I Know I didnt specify in the original post (Didnt think of it till now).... Would it be possible to do the same but with mulitple columns... ie Letter A in col H2, Letter "B" in col I2, Letter "C" in Col then the all fill out with thier pairing letter. No problems if it cant be done easy...... I can just use a seperate code for each letter. Thanks again

  • Another possibilty maybe

    Code
    Sub AAAAA()
    Dim c As Range
        For Each c In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
            If Len(c.Value) - Len(Replace(c.Value, [H1], "")) = 1 Then c.Offset(, 1).Value = Replace(c.Value, [H1], "")
        Next c
    End Sub


    If capitalization comes into play, use

    Code
    Option Compare Text

    at the top

  • Hi How How,


    Glad we're on the right track. Here's my codes adapted to work for what's in cells H2, I2 and J2:



    HTH


    Robert

  • Code
    Sub AAAAA_3_Columns()
    Dim c As Range, i As Long
        For Each c In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
            For i = 8 To 10    '<----- assuming letters are in columns H, I and J
                If Len(c.Value) - Len(Replace(c.Value, Cells(1, i).Value, "")) = 1 Then c.Offset(, 1).Value = Replace(c.Value, Cells(1, i).Value, "")
            Next i
        Next c
        ActiveSheet.UsedRange.Columns(3).SpecialCells(4).Delete Shift:=xlUp
    End Sub


    To the both of you, a Merry Christmas and a Happy and Prosperous New Year.

  • Trebor76... I have done what I was requiring by doing as below (Many times)... So that All letter "A" pairs will be in Col H, all letter "B" pairs will be in Col I and so on...... Working perfectly this way, just wondered if there was a shorter code to do the same...... No probs if cant be done easily.



  • Re: just wondered if there was a shorter code to do the same
    Maybe I am missing something but why is that important?


    How big is the range you're working with? Have you put a timer on both codes to see how long each takes on your actual workbook?

  • Here is a shorter (amount of lines) code.
    The time difference between Trebor76's code and this code on 4700 entries is 0.08 seconds in favor of this code on my machine.


    Code
    Sub How_How_2()
    Dim c As Range, i As Long
        Application.ScreenUpdating = False
        For Each c In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)    '<----- 4700 entries
            For i = 8 To 10
                If Len(c.Value) - Len(Replace(c.Value, Cells(1, i).Value, "")) = 1 Then Cells(Rows.Count, c.Offset(, 1).Column).End(xlUp).Offset(1).Value = Replace(c.Value, Cells(1, i).Value, "")
            Next i
        Next c
        Application.ScreenUpdating = True
    End Sub
  • Jolivanes, Merry XMas...... Your code is putting everything in col C (Originally asked for)..... See the picture below, all letter "A" pairing will now start in "H2", Letter "B" pairing will start in "I2" and so on. I needed to copy Trebor76 code 17 times changing the col & letter each time... Works fine, I was just wondering if this could be shortened.
    P.s The numbers on row 20 are for Byes to be applied in case of odd numbers (The numbers will have to be manually inputted and will be variable).
    [ATTACH=JSON]{"data-align":"none","data-size":"full","title":"Example.JPG","caption":"Caption","data-attachmentid":1197326}[/ATTACH]

  • Re: I needed to copy Trebor76 code 17 times
    Our alphabet has 26 letters, not 17
    Start from scratch explaining what you have and where you have it and what needs to go from wherever to wherever with the code.
    I am not being nasty but the "all letter "A" pairing will now start in "H2", Letter "B" pairing will start in "I2" and so on" indicates to me A to Z but the "17 times" quashes that idea.
    It looks to me like you want the remaining letter under the letter that you discard.
    If you work on Column H (the letter A), Cell H2 would have an "L", Cell H3 a "J" and Cell H4 an "H".
    For Column I (the letter B) it would be a "K", "I" and a "G"
    Is that right?
    A Merry Christmas and a Happy and Prosperous New Year to you and yours.

  • If the scenario in the previous post is right, this might do what you want (try it on a copy of your wb).

  • As well as jolivanes's nifty code here's my revised attempt which dynamically finds the last column (using Row 1) in the worksheet each time the macro is run:



    Robert

  • Wow, both codes work as designed and the timings are very similar........ Both much less code than I have just now...... Thank you both very much........ All on X-mas day too....... Great help and hopefully I will learn more from this.


    With both codes I had to remove the numbers from row 20 because the data was being put below them, but this is not a hardship as I can move the numbers to another location. (Numbers were for weekly bye's)


    I will go and work with this, I will be trying to add a "Bye" in the column where each team will have to have a bye when there is an odd number (Week 1, week 2 etc).... But I will have a go myself & if I do get stuck I will start another thread. Thanks again :rock:

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!