Option Explicit
Sub ReformatData()
'JBeaucaire (11/16/2009)
Dim LR As Long, i As Long
Application.ScreenUpdating = False
If Range("A1") <> "Firm EFIN" Then
MsgBox "Please bring up the data sheet before activating the macro."
Exit Sub
End If
Range([A1], [A1].SpecialCells(xlLastCell)).Sort Key1:=Range("C2"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Columns("G:H").Insert Shift:=xlToRight
Columns("J:K").Insert Shift:=xlToRight
Columns("M:N").Insert Shift:=xlToRight
Columns("P:Q").Insert Shift:=xlToRight
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 3 Step -1
If Cells(i, "C") = Cells(i - 1, "C") Then
If Application.WorksheetFunction.CountIf(Range(Cells(i, "F"), Cells(i, "H")), Cells(i - 1, "F")) = 0 Then
Range(Cells(i, "F"), Cells(i, "M")).Copy
Cells(i - 1, "G").PasteSpecial xlPasteValues, SkipBlanks:=True
Rows(i).Delete xlShiftUp
Else
Rows(i - 1).Delete xlShiftUp
End If
End If
Next i
Range("G1,J1,M1,P1").FormulaR1C1 = "=RC[-1]&"" 2"""
Range("H1,K1,N1,Q1").FormulaR1C1 = "=RC[-2]&"" 3"""
Rows(1).Value = Rows(1).Value
Cells.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
1. Open up your workbook
2. Get into VB Editor
3. Insert a new module
4. Copy and Paste in your code (given above)
5. Get out of VBA
6. Save your sheet
The macro is installed and ready to use.
macro from the popup window.
Bookmarks