Move data to columns depending on value

Sharid · May 5, 2018

I have a web form that collects data, there are 4 radio buttons depending on which radio button has been selected the value of that radio button goes into column B

Radio buttons

Hat
Cat
Bat
Mat

If radio button 2 is selected column B will have the value of “Cat”. When the form is filled in again the next row in column B will have new value depending on what radio button was selected

E.G.
Column A Column B
Row1 Cat
Row2 Mat
Row3 Bat
Row4 Cat
Row5 Cat
Row6 Hat
Row7 Hat

I need a VBA Code that will sort this data into separate columns,

 So when the code is runs the date is moved to the following columns

· Hat = Column B
· Cat = Column C
· Bat = Column D
· Mat = Column E

Thanks for having a look

MickG · May 5, 2018

Try this :-
If this is not the expected result, please show example of results.
NB:- I've assumed the data for transposing is in column "B" which is deleted in the code.

Code:

[COLOR="Navy"]Sub[/COLOR] MG05May26
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] b [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] d [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] e [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Application.Transpose(Range("B1", Range("B" & Rows.Count).End(xlUp)))
Columns("B:B").ClearContents
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray)
    [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Ray(n)
        [COLOR="Navy"]Case[/COLOR] "Hat": b = b + 1: Cells(b, "B") = Ray(n)
        [COLOR="Navy"]Case[/COLOR] "Cat": c = c + 1: Cells(c, "C") = Ray(n)
        [COLOR="Navy"]Case[/COLOR] "Bat": d = d + 1: Cells(d, "D") = Ray(n)
        [COLOR="Navy"]Case[/COLOR] "Mat": e = e + 1: Cells(e, "E") = Ray(n)
    [COLOR="Navy"]End[/COLOR] Select
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

Sharid · May 5, 2018

MickG
Thanks for your code, I have not tested it yet. If your code works, I will go with it as its much shorter

I was able to do it with this

Code:

Private Sub CommandButton1_Click()
Dim row As Long

    For row = 2 To 1000
        ' Check if "Hat" appears in the value anywhere.
        If Range("B" & row).Value Like "*Hat*" Then
            ' Copy the value and then blank the source.
            Range("B" & row).Value = Range("B" & row).Value
            
        End If
    'Next
       If Range("B" & row).Value Like "*Cat*" Then
            ' Copy the value and then blank the source.
            Range("C" & row).Value = Range("B" & row).Value
            Range("B" & row).Value = ""
        
        End If
        If Range("B" & row).Value Like "*Bat*" Then
            ' Copy the value and then blank the source.
            Range("D" & row).Value = Range("B" & row).Value
            Range("B" & row).Value = ""
        
        End If
        
        If Range("B" & row).Value Like "*Mat*" Then
            ' Copy the value and then blank the source.
            Range("E" & row).Value = Range("B" & row).Value
            Range("B" & row).Value = ""
        
        End If
    Next
End Sub

Sharid · May 5, 2018

MickG

Your code does not keep the data on the same Rows , IT MOVES it to the next empty cell in that column. Your code moves the date to the correct columns but does not maintain the rows

MickG · May 5, 2018

This may Do !!

Code:

[COLOR="Navy"]Sub[/COLOR] MG05May53
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("B1", Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Dn.Value
        [COLOR="Navy"]Case[/COLOR] "Cat": Dn.Cut Dn.Offset(, 1)
        [COLOR="Navy"]Case[/COLOR] "Bat": Dn.Cut Dn.Offset(, 2)
        [COLOR="Navy"]Case[/COLOR] "Mat": Dn.Cut Dn.Offset(, 3)
    [COLOR="Navy"]End[/COLOR] Select
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

Sharid · May 6, 2018

[FONT=&quot]Thanks MickG for helping me out again, you have saved me once more.[/FONT]

MickG · May 6, 2018

You're welcome

Move data to columns depending on value

Sharid

Well-known Member

Excel Facts

MickG

MrExcel MVP

Sharid

Well-known Member

Sharid

Well-known Member

MickG

MrExcel MVP

Sharid

Well-known Member

MickG

MrExcel MVP

Similar threads

Forum statistics

Share this page

Move data to columns depending on value

Sharid

Well-known Member

Excel Facts

MickG

MrExcel MVP

Sharid

Well-known Member

Sharid

Well-known Member

MickG

MrExcel MVP

Sharid

Well-known Member

MickG

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock