View Full Version : Re-arranging the columns as per columns given in another worsheet
sindhuja
03-14-2012, 10:50 PM
Hi,
can some one assist with the below requirement.
I have attached the sample spreadsheet for the reference in which we have three tabs Actual, expected and rearrange.
In rearrange sheet i have the column names according to which the columns to be arranged in expected sheet. There might be more than one occurrence of the column ex hdng9 appear twice in the expected.
Once the columns has been rearranged, we need to delete the actual and the rearrange sheet.
Formatting of the sheet should be Times new roman always with font size 8, contents left aligned. Once all these done, should ask for the save as option to save the file.
-sindhuja
mancubus
03-15-2012, 01:51 AM
hi.
Sub copy_matching_cols()
'http://www.vbaexpress.com/forum/showthread.php?t=41390
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim fCell As Range, cll As Range
Dim LR As Long
Set ws1 = Sheets("Actual")
Set ws2 = Sheets("Output")
Set ws3 = Sheets("Rearrange")
ws2.Cells.Clear
Range(ws3.Range("A2"), ws3.Range("A2").End(xlDown)).Copy
Sheets("Output").Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
For Each cll In Range(ws2.Range("A1"), ws2.Range("IV1").End(xlToLeft))
With ws1
Set fCell = .Rows(1).Find(What:=cll.Value, LookAt:=xlWhole)
If Not fCell Is Nothing Then
LR = .Cells(.Rows.Count, fCell.Column).End(xlUp).Row
.Range(.Cells(2, fCell.Column), .Cells(LR, fCell.Column)).Copy _
Destination:=ws2.Cells(2, cll.Column)
End If
End With
Next
Application.DisplayAlerts = False 'deletes "Actual" and "Rearrange" sheets without warning
ws1.Delete
ws3.Delete
Application.DisplayAlerts = True
With ws2.Cells
.Font.Name = "Times New Roman"
.Font.Size = 8
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
ChDir "C:\Documents\My Documents\xxx\xxxxx\" 'change to suit
Application.GetSaveAsFilename
End Sub
Bob Phillips
03-15-2012, 06:05 AM
Another way
Sub rearrange()
Dim vecColumns As Variant
Dim cell As Range
Dim lastrow As Long
Dim i As Long
With Worksheets("Rearrange")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
ReDim vecColumns(1 To lastrow - 1)
For i = 2 To lastrow
vecColumns(i - 1) = Application.Match(.Cells(i, "A"), Worksheets("Actual").Rows(1), 0)
Next i
End With
With ActiveSheet
With .UsedRange
.Value = Application.Index(.Value, _
.Parent.Evaluate("ROW(" & .Columns(1).Address & ")"), _
vecColumns)
End With
For Each cell In .UsedRange
If Application.IsNA(cell) Then cell.ClearContents
Next cell
End With
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.