Converting multiple columns to one & use in a defined ra

A

aka_krakur

Active Member
Joined
Jan 31, 2006
Messages
438
I have a query that brings back data that is separated by a semicolon. I then break those apart into separate columns because each data after each semicolon is it's own code and I am using these in a listbox on a userform.

Manually this is no problem; but I need to validate where these codes are coming from, so I created a query that looks them up and refreshes the list accordingly. Again, this is all manually done right now.

so, the steps I do I've started recording a macro but where I come into trouble is sometimes Column A when I convert to separate columns so I can get one long list, it varies how many columns it's expanded in to. Sometimes it could be up to Column H, sometimes it's only to Column F.

Maybe I'm going about this all wrong and there's an easier way to accomplish getting all these codes into one column so it may be used on a userform in a listbox.

Criteria that's a must.
1. I have to split them up (semicolon is the factor that helps with this)
2. I have to remove duplicates.
3. Defined Name Range will probably change every once in a while.

Here is a pasted sample of the data I am working with:

BEFORE
Book1
ABCD
1Before
2REPORTED_DEV_CLARIFICATION
31049-Above;
41049-Above;1069-Shaft;1670-AboveRBP;
51049-Above;1586-Balloon;
61049-Above;1586-Balloon;1670-AboveRBP;
71049-Above;1586-Balloon;1670-AboveRBP;1586-Tip;
81049-Above;1586-Shaft;1670-AboveRBP;1670-AgainstResistance;
91049-Above;1670-AboveRBP;
101049-Above;1670-AboveRBP;1528-BalloonCatheter;1586-Balloon;
111049-Above;1670-AboveRBP;1586-Balloon;
121049-Above;1670-AboveRBP;1586-Shaft;1586-Balloon;
131049-Below;
141049-Below;1158-Dislodged;
151049-Below;1158-Partial;1670-OffLabelUse;
161049-Below;1528-GuideWire;
171049-Below;1528-GuideWire;1670-OffLabelUse;
181049-Below;1586-Balloon;
191049-Below;1586-Shaft;
201049-Below;1586-Shaft;1670-OffLabelUse;
Sheet1



AFTER
Book1
ABCD
22After
23REPORTED_DEV_CLARIFICATION
241049-Above
251049-Above1069-Shaft1670-AboveRBP
261049-Above1586-Balloon
271049-Above1586-Balloon1670-AboveRBP
281049-Above1586-Balloon1670-AboveRBP1586-Tip
291049-Above1586-Shaft1670-AboveRBP1670-AgainstResistance
301049-Above1670-AboveRBP
311049-Above1670-AboveRBP1528-BalloonCatheter1586-Balloon
321049-Above1670-AboveRBP1586-Balloon
331049-Above1670-AboveRBP1586-Shaft1586-Balloon
341049-Below
351049-Below1158-Dislodged
361049-Below1158-Partial1670-OffLabelUse
371049-Below1528-GuideWire
381049-Below1528-GuideWire1670-OffLabelUse
391049-Below1586-Balloon
401049-Below1586-Shaft
411049-Below1586-Shaft1670-OffLabelUse
Sheet1
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
so is the next step after this to put columns b,c, and d underneath column A and then filter to get unique data?
 
Upvote 0
Yes. But that's where I get stuck. Because this is just a sample data. Sometime it could be up to Column F. It varies on this aspect.
 
Upvote 0
Well, I don't see any responses in a couple days.
Any chance anyone can help me with this.
Looking to see if there's a code that can automatically combine split columns into one continous list. (See 1st posting for samples and more detail as to what I'm looking to accomplish.
 
Upvote 0
sorry, got sidetracked
try this (its untested)

Sub selectcells()
Dim c As Range
x = 1
y = 2

Worksheets("Sheet1").Activate
Do
For Each c In Range(Cells(x, y), Cells(10, y))
If c <> "" Then c.Select
Selection.Cut
Columns("A:A").Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Select
lastcell = Selection.Row
Cells(lastcell, 1).Activate
ActiveSheet.Paste
Next
y = y + 1
Loop Until y = 8

End Sub
 
Upvote 0
The code that gingerafro helped me with works, but it's a huge loop that takes forever when it comes to using it with all my data (about 2550 rows worth).
Code: 
Dim c As Range
x = 1
Y = 2

Worksheets("Reported_Dev_Clarification").Activate
lastCell = Range("A65536").End(xlUp).Row
Do
For Each c In Range(Cells(x, Y), Cells(lastCell, Y))
If c <> "" Then c.Select
Selection.Cut
Columns("A:A").Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Select
lastCell = Selection.Row
Cells(lastCell, 1).Activate
ActiveSheet.Paste
Next
Y = Y + 1
Loop Until Y = 8

Here's the code I originally started with (and it works as it was based off of a simple recorded macro); however, the problem I run in to is --
Is there a way to write an if statement or something of that nature to stop the sorting, etc, if it recognizes that column to have no data?

Here's my code:

Code: 
Sub MacroOLD()

'Sort Columns - Descending (This gets rid of blank rows)

      Range("B2:B65536").Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("C2:C65536").Select
    Selection.Sort Key1:=Range("C2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("D2:D65536").Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("E2:E65536").Select
    Selection.Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("F2:F65536").Select
    Selection.Sort Key1:=Range("F2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G2:G65536").Select
    Selection.Sort Key1:=Range("G2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("H2:H65536").Select
    Selection.Sort Key1:=Range("H2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
   Range("I2:I65536").Select
    Selection.Sort Key1:=Range("I2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("J2:J65536").Select
    Selection.Sort Key1:=Range("J2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
  Range("K2:K65536").Select
    Selection.Sort Key1:=Range("K2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Range("L2:L65536").Select
    Selection.Sort Key1:=Range("L2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Range("M2:M65536").Select
    Selection.Sort Key1:=Range("M2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    ' Copymove Macro--copies each column according to the last set of data in that row over to end of data on column A
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("A2").Select
    Selection.End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("A2").Select
    Selection.End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("A2").Select
    Selection.End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("A2").Select
    Selection.End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("A2").Select
    Selection.End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Range("G2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("A2").Select
    Selection.End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

Problem is if let's say Column G2 didn't have any data in it, the macro stops at this point because it can't copy/paste G2:G65536 (which is what it selects) at this point if there's no data) into Column A(lastrow)

If someone can show me how to write an if statement (if that's possible) to make it stop the code if there's no data, or keep going (loop) until it finds blank data---I would appreciate it.

The 1st code above was nice; it just is a huge time consuming loop. Mine doesn't take but a few sec's; but I need to sureproof it to stop when there's no data, or keep going if there is.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Using offset to convert one column to multiple rows when data is inconsistent - HELP!
Replies
1
Views
476
Peter_SSs
Peter_SSs
S
  • Question Question
Code to use multiple trigger cells to hide / unhide rows of corresponding question sets
Replies
1
Views
1K
dmt32
D
A
  • Locked
  • Question Question
Macro to move multiple columns into one
Replies
1
Views
435
Von Pookie
Von Pookie
A
  • Question Question
Text to columns then consolidated into one column
Replies
8
Views
566
aka_krakur
A

Forum statistics

Threads
1,225,483
Messages
6,185,263
Members
453,284
Latest member
osy25

Share this page

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
Back
Top