Converting multiple columns to one & use in a defined ra

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 lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

gingerafro

Active Member
Joined
Mar 23, 2005
Messages
448
so is the next step after this to put columns b,c, and d underneath column A and then filter to get unique data?
 

aka_krakur

Active Member
Joined
Jan 31, 2006
Messages
438
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.
 

aka_krakur

Active Member
Joined
Jan 31, 2006
Messages
438
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.
 

gingerafro

Active Member
Joined
Mar 23, 2005
Messages
448

ADVERTISEMENT

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
 

aka_krakur

Active Member
Joined
Jan 31, 2006
Messages
438
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.
 

Forum statistics

Threads
1,141,018
Messages
5,703,756
Members
421,313
Latest member
Mooncake1

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