PDA

View Full Version : Solved: Arrange Columns based on header values



Sir Babydum GBE
04-20-2012, 02:10 AM
Hi

I have shipping spreadsheets that are sent to me which I then need to manipulate with vba. I remove unneeded columns and rename others (among other things)

My first problem is that sometimes the spreadhseets are not always uniform. On one spreadsheet, "Product Code" will be on column B and another time it will be on C.

The header labels are in row 3 of the spreadsheet.

So basically, instead of simply deleting this or that column I need to say: Find the column with "Product Code" as its header and, if its not already Column B, then move it there. Then find colum "Weight" and make sure it's column C. etc etc.

But if it looks for a header and its not there at all, It should create a column with that header in the right place.

Is this possible?

Many thanks

BD

snb
04-20-2012, 02:19 AM
I wasn't able to open your sample workbook ....;)

Sir Babydum GBE
04-20-2012, 02:24 AM
I wasn't able to open your sample workbook ....;)I didn't attach one. If you think it will help I'll make a mock up...
Cheers

snb
04-20-2012, 04:02 AM
You got it !

By the way; in the first place: it helps you !

Bob Phillips
04-20-2012, 04:57 AM
Sir BD,

I tested with a target set of headings of

Tarn,River,Lake,Creek,Puddle,Billabong,Stream

in that order, and an input with just four values,

Billabong,Creek,River,Stream

and in that order.


This code adds the extra headings and re-orders the columns


Public Sub RearrangeData()
Const LIST_HEADINGS As String = _
"Tarn,River,Lake,Creek,Puddle,Billabong,Stream"
Dim vecHeadings As Variant
Dim vecColumns As Variant
Dim lastcol As Long
Dim i As Long

vecHeadings = Split(LIST_HEADINGS, ",")
With ActiveWorkbook.ActiveSheet

lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = LBound(vecHeadings) To UBound(vecHeadings)

If IsError(Application.Match(vecHeadings(i), .Rows(1), 0)) Then

lastcol = lastcol + 1
.Cells(1, lastcol).Value = vecHeadings(i)
End If
Next i
ReDim vecColumns(1 To UBound(vecHeadings) - LBound(vecHeadings) + 1)
For i = 1 To lastcol

vecColumns(i) = Application.Match(.Cells(1, i).Value, vecHeadings, 0)
Next i
.Rows(1).Insert
.Range("A1").Resize(1, UBound(vecHeadings) - LBound(vecHeadings) + 1) = vecColumns
With .UsedRange
.Sort Key1:=.Range("A1"), Order1:=xlAscending, _
Orientation:=xlLeftToRight
End With
.Rows(1).Delete
End With
End Sub

Sir Babydum GBE
04-20-2012, 05:53 AM
Sir BD,

I tested with a target set of headings of

Tarn,River,Lake,Creek,Puddle,Billabong,Stream

in that order, and an input with just four values,

Billabong,Creek,River,Stream

and in that order.That's excellent too!
Just one question: Sometimes A sheet will be sent to me with extra columns of data that i don't need. When I test your macro it stall when it encounters something NOT on the expected list of headers. Could you tweak it for me so that any columns not listed are removed?

It stalls here:vecColumns(i) = Application.Match(.Cells(1, i).Value, vecHeadings, 0)
Thanks

Damian

Bob Phillips
04-20-2012, 06:04 AM
I have added another loop to delete the 'invalid' columns. I could probably have merged the two column handling loops, or even used 'cute' techniques to insert/delete, but the number of columns is unlikely to significantly affect performance, so KISS

Public Sub RearrangeData()
Const LIST_HEADINGS As String = _
"Tarn,River,Lake,Creek,Puddle,Billabong,Stream"
Dim vecHeadings As Variant
Dim vecColumns As Variant
Dim lastcol As Long
Dim i As Long

Application.ScreenUpdating = False

vecHeadings = Split(LIST_HEADINGS, ",")
With ActiveWorkbook.ActiveSheet

lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = LBound(vecHeadings) To UBound(vecHeadings)

If IsError(Application.Match(vecHeadings(i), .Rows(1), 0)) Then

lastcol = lastcol + 1
.Cells(1, lastcol).Value = vecHeadings(i)
End If
Next i

For i = lastcol To 1 Step -1

If IsError(Application.Match(.Cells(1, i).Value, vecHeadings, 0)) Then

.Columns(i).Delete
lastcol = lastcol - 1
End If
Next i

ReDim vecColumns(1 To UBound(vecHeadings) - LBound(vecHeadings) + 1)
For i = 1 To lastcol

vecColumns(i) = Application.Match(.Cells(1, i).Value, vecHeadings, 0)
Next i

.Rows(1).Insert
.Range("A1").Resize(1, UBound(vecHeadings) - LBound(vecHeadings) + 1) = vecColumns
With .UsedRange
.Sort Key1:=.Range("A1"), Order1:=xlAscending, _
Orientation:=xlLeftToRight
End With
.Rows(1).Delete
End With

Application.ScreenUpdating = True
End Sub

Sir Babydum GBE
04-20-2012, 06:32 AM
I have added another loop to delete the 'invalid' columns. I could probably have merged the two column handling loops, or even used 'cute' techniques to insert/delete, but the number of columns is unlikely to significantly affect performance, so KISSAnd its perfect. Thanks so much as always

BD ("Sir" - but not to you)

Sir Babydum GBE
04-20-2012, 06:45 AM
In fact, if you were an Ant, you'd be a Brilly Ant!

(I astound myself sometime, I truly do)

Bob Phillips
04-20-2012, 07:00 AM
(I astound myself sometime, I truly do)

You astound us all :)

snb
04-20-2012, 07:40 AM
or.
Assuming in A1:H1

aa|qq|ff|kk|pp|cc|tt|zz

Sub snb()
sn = Cells(1).CurrentRegion.Rows(1)

st = Array("pp", "ff", "tt")
For j = 0 To UBound(st)
If Not IsError(Application.Match(st(j), sn, 0)) Then st(j) = Application.Match(st(j), sn, 0)
Next

Cells(1, 10).Resize(Cells(1).CurrentRegion.Rows.Count, UBound(st) + 1) = Application.Index(Cells(1).CurrentRegion.Value, [row(1:100)], st)
End Sub

Aussiebear
04-21-2012, 03:12 AM
I astound myself sometime, I truly do

A touch of reality will do that you know!