Sub new_functions()
Call new_supyear
Call new_supcol
Call new_addyear
Call new_keep
Call new_compar2
Call new_segment
Call new_TDC_a_jour
End Sub
Sub new_supyear()
Dim Year As Integer
Dim GF As Integer
Dim nblignes As Long
Worksheets("new_allyear").Activate
nblignes = Range("A1").End(xlDown).Row
nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column
For i = 1 To nbColonnes
If Cells(1, i).Text = "Year" Then Year = i
If Cells(1, i).Text = "Green Field" Then GF = i
Next i
Range(Cells(2, 1), Cells(nblignes, nbColonnes)).Select
Selection.Sort Key1:=Cells(2, Year), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For i = nblignes To 2 Step -1
If Cells(i, Year) = current_year - 1 Then
stophere = i + 1
i = 2
End If
Next i
Rows(stophere & ":" & nblignes).Select
Selection.Delete
' Rows("1:1").Select
' Selection.AutoFilter Field:=Year, Criteria1:="=" & current_year
' ActiveSheet.UsedRange.Rows("2:" & ActiveSheet.UsedRange.Rows.Count).Select
' Selection.Delete Shift:=xlUp
Worksheets("new_allyear").AutoFilterMode = False
If GF <> 0 Then
Columns(GF).Select
Selection.Delete Shift:=xlToRight
End If
End Sub
Sub new_supcol()
Worksheets("new_allyear").Activate
nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column
Dim keep As Integer
Dim Network As Integer
Dim Group As Integer
Dim Seg As Integer
Dim keep2 As Integer
Dim Network2 As Integer
Dim Group2 As Integer
Dim Seg2 As Integer
For i = 1 To nbColonnes
If Cells(1, i).Text = "Last_modified_order" Then keep = i
If Cells(1, i).Text = "Network_size" Then Network = i
If Cells(1, i).Text = "Group" Then Group = i
If Cells(1, i).Text = "Segment" Then Seg = i
Next i
If Seg <> 0 Then
Columns(Seg).Select
Selection.Delete Shift:=xlToLeft
End If
If Group <> 0 Then
Columns(Group).Select
Selection.Delete Shift:=xlToLeft
End If
If Network <> 0 Then
Columns(Network).Select
Selection.Delete Shift:=xlToLeft
End If
If keep <> 0 Then
Columns(keep).Select
Selection.Delete Shift:=xlToLeft
End If
Worksheets(current_year).Select
nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column
For i = 1 To nbColonnes
If Cells(1, i).Text = "Last_modified_order" Then keep2 = i
If Cells(1, i).Text = "Network_size" Then Network2 = i
If Cells(1, i).Text = "Group" Then Group2 = i
If Cells(1, i).Text = "Segment" Then Seg2 = i
Next i
If Seg2 <> 0 Then
Columns(Seg2).Select
Selection.Delete Shift:=xlToLeft
End If
If Group2 <> 0 Then
Columns(Group2).Select
Selection.Delete Shift:=xlToLeft
End If
If Network2 <> 0 Then
Columns(Network2).Select
Selection.Delete Shift:=xlToLeft
End If
If keep2 <> 0 Then
Columns(keep2).Select
Selection.Delete Shift:=xlToLeft
End If
End Sub
Sub new_addyear()
Dim OT As Integer
Worksheets(current_year).Select
nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column
For i = 1 To nbColonnes
If Cells(1, i).Text = "000_offer_type" Then
OT = i
i = nbColonnes
End If
Next i
Cells(1, 1).Select
Selection.AutoFilter Field:=OT, Criteria1:="=0"
ActiveSheet.UsedRange.Rows("2:" & ActiveSheet.UsedRange.Rows.Count).Select
Selection.Copy
Worksheets(current_year).AutoFilterMode = False
Sheets("new_allyear").Select
nblignes = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
Cells(nblignes + 1, 1).Select
ActiveSheet.Paste
End Sub
Sub new_keep()
Dim nblignes As Long
Dim ColOffer As Integer
Worksheets("new_allyear").Activate
nblignes = Range("A1").End(xlDown).Row
nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column
For i = 1 To nbColonnes
If Cells(1, i).Text = "Offer" Then
ColOffer = i
i = nbColonnes
End If
Next i
Cells(1, 1).Select
Range(Cells(2, ColOffer), Cells(nblignes, nbColonnes)).Select
Selection.Sort Key1:=Cells(2, ColOffer), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Cells(1, 9) = "Last_modified_order"
For i = 2 To nblignes
X = Cells(i, 1)
Cells(i, 2) = Left(X, 9)
Next i
For i = 3 To nblignes
Cells(i - 1, 9).NumberFormat = "0"
If Cells(i - 1, 2) = Cells(i, 2) Then
Cells(i - 1, 9) = "0"
Else
Cells(i - 1, 9) = "1"
End If
Next i
Columns(9).Select
Selection.NumberFormat = "General"
Cells(nblignes, 9) = "1"
Columns(9).Select
Selection.NumberFormat = "General"
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
End Sub
Sub new_compar2()
'
' compar2 Macro
' Macro enregistrée le 20/10/2009 par adekerro
'
Dim nblignes As Long
Dim colName As Integer
Dim colCust As Integer
Dim colcomp1 As Integer
Dim colcomp2 As Integer
Worksheets("new_allyear").Activate
nblignes = Range("A1").End(xlDown).Row
nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column
For i = 1 To nbColonnes
If Cells(1, i).Text = "Name" Then colName = i
If Cells(1, i).Text = "006_Form_Cust_name" Then colCust = i
Next i
Columns(colCust + 1).Insert (xlToRight)
Cells(1, colCust + 1) = "compar2"
Columns(colName + 1).Insert (xlToRight)
Cells(1, colName + 1) = "compar1"
For i = 1 To nbColonnes
If Cells(1, i).Text = "compar2" Then colcomp2 = i
If Cells(1, i).Text = "compar1" Then colcomp1 = i
Next i
'Columns(colName + 1).Select
'Selection.Insert Shift:=xlToRight
For i = 2 To nblignes
Cells(i, colcomp1) = "=compar(RC[-1],R[-1]C[-1])"
'Calculate
Cells(i, colcomp1).Value = Cells(i, colcomp1).Value
If Cells(i, colcomp2 - 1) <> "" And Cells(i - 1, colcomp2 - 1) <> "" Then
Cells(i, colcomp2) = "=compar(RC[-1],R[-1]C[-1])"
Cells(i, colcomp2).Value = Cells(i, colcomp2).Value
End If
Next i
End Sub