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
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
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 :)
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!
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.