i can not run my macro to all worksheets.
all the worksheets have same structure
worksheet names are 199201 ... 199212
can any one help me
all the worksheets have same structure
worksheet names are 199201 ... 199212
can any one help me
Code:
Sub Weights()
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row - 2
'change font before running macro
Range("A1").CurrentRegion.Select
With Selection.Font
.Name = "Tahoma"
.Size = 8
End With
' 1-making value from tarrif column
Range("G2").Select
ActiveCell.FormulaR1C1 = "=VALUE(RC[-4])"
Range("G2").Select
Selection.Copy
Range("F2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
' 2-paste special value to tariff column
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 3-delet column G value formulas
Columns("G:G").Select
Application.CutCopyMode = False
Selection.ClearContents
' 4- sort on tariffs
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("C2").End(xlDown) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("A1").CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' 5- unique list from 10 digit tariff with advance filtering
Range("G1").Select
Columns("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"G:G"), Unique:=True
' 6-fitting column G + rename to t10 + sumif
Columns("G:G").EntireColumn.AutoFit
ActiveCell.FormulaR1C1 = "t10"
Range("H1").Select
ActiveCell.FormulaR1C1 = "s10"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=SUMIF(RC[-5]:R[" & LR & "]C[-4],RC[-1],RC[-4]:R[" & LR & "]C[-4])"
Range("H2").Select
Selection.Copy
Range("G2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("H2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 7-titling and trunc for driving 8,6,4,2 tariff codes
Columns("H:K").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select
ActiveCell.FormulaR1C1 = "t08"
Range("I1").Select
ActiveCell.FormulaR1C1 = "t06"
Range("J1").Select
ActiveCell.FormulaR1C1 = "t04"
Range("K1").Select
ActiveCell.FormulaR1C1 = "t02"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=TRUNC(RC[-1]/100)"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=TRUNC(RC[-2]/10000)"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=TRUNC(RC[-3]/1000000)"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=TRUNC(RC[-4]/100000000)"
Range("K2").Select
Range("H2:K2").Select
Selection.Copy
Range("G2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 8- change value to text for sumif and respecting duplicates
Range("M2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(""00000""&RC[-6],10)"
Range("N2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(""00000""&RC[-6],8)"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(""00000""&RC[-6],6)"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(""00000""&RC[-6],4)"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(""00000""&RC[-6],2)"
Range("M2:Q2").Select
Selection.Copy
Range("L2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("M:Q").Select
Application.CutCopyMode = False
Selection.ClearContents
' 9-unique list for t08,t06,t04,t02
Range("M1").Select
Columns("H:H").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"M:M"), Unique:=True
Range("N1").Select
Columns("I:I").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"N:N"), Unique:=True
Range("O1").Select
Columns("J:J").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"O:O"), Unique:=True
Range("P1").Select
Columns("K:K").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"P:P"), Unique:=True
' 10-computing weights
' inserting between columns
Columns("N:N").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("P:P").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("R:R").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' naming columns
Range("N1").Select
ActiveCell.FormulaR1C1 = "s08"
Range("P1").Select
ActiveCell.FormulaR1C1 = "s06"
Range("R1").Select
ActiveCell.FormulaR1C1 = "s04"
Range("T1").Select
ActiveCell.FormulaR1C1 = "s02"
' sumifs
Range("N2").Select
ActiveCell.FormulaR1C1 = "=SUMIF(RC[-6]:R[" & LR & "]C[-2],RC[-1],RC[-2]:R[" & LR & "]C[-2])"
Range("N2").Select
Selection.Copy
Range("M2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("P2").Select
ActiveCell.FormulaR1C1 = "=SUMIF(RC[-7]:R[" & LR & "]C[-4],RC[-1],RC[-4]:R[" & LR & "]C[-4])"
Range("P2").Select
Selection.Copy
Range("O2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("R2").Select
ActiveCell.FormulaR1C1 = "=SUMIF(RC[-8]:R[" & LR & "]C[-6],RC[-1],RC[-6]:R[" & LR & "]C[-6])"
Range("R2").Select
Selection.Copy
Range("Q2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("T2").Select
ActiveCell.FormulaR1C1 = "=SUMIF(RC[-9]:R[" & LR & "]C[-8],RC[-1],RC[-8]:R[" & LR & "]C[-8])"
Range("T2").Select
Selection.Copy
Range("S2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
' preparing for weighting
' copy t10 near s10
Columns("L:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("G:G").Select
Selection.Copy
Columns("L:L").Select
ActiveSheet.Paste
' insert columns for weights and titling
Columns("N:N").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("T:T").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("W:W").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").Select
ActiveCell.FormulaR1C1 = "w10"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "w08"
Range("T1").Select
ActiveCell.FormulaR1C1 = "w06"
Range("W1").Select
ActiveCell.FormulaR1C1 = "w04"
Range("Z1").Select
ActiveCell.FormulaR1C1 = "w02"
' weight 10 in 08 or w10
Range("N2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]/VLOOKUP(LEFT(RC[-2],8),R2C15:R[" & LR & "]C16,2,0)"
Range("N2").Select
Selection.Copy
Range("M2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
' weight 08 in 06 or w08
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]/VLOOKUP(LEFT(RC[-2],6),R2C18:R[" & LR & "]C19,2,0)"
Range("Q2").Select
Selection.Copy
Range("P2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
' weight 06 in 04 or w06
Range("T2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]/VLOOKUP(LEFT(RC[-2],4),R2C21:R[" & LR & "]C22,2,0)"
Range("T2").Select
Selection.Copy
Range("S2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
' weight 04 in 02 or w04
Range("W2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]/VLOOKUP(LEFT(RC[-2],2),R2C24:R[" & LR & "]C25,2,0)"
Range("W2").Select
Selection.Copy
Range("V2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
'computing 4sigmaw or fore sigma weights
Columns("L:L").Select
Selection.Copy
Columns("AA:AA").Select
ActiveSheet.Paste
Range("AB1").Select
ActiveCell.FormulaR1C1 = "4sigmaw"
Range("AB2").Select
ActiveCell.FormulaR1C1 = _
"=RC[-14]*VLOOKUP(LEFT(RC[-16],8),R2C15:R[" & LR & "]C17,3,0)*VLOOKUP(LEFT(RC[-16],6),R2C18:R[" & LR & "]C20,3,0)*VLOOKUP(LEFT(RC[-16],4),R1C21:R[" & LR & "]C23,3,0)"
Range("AB2").Select
Selection.Copy
Range("AA2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
' 11-computing weight and prices for t02
Columns("AB:AB").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AB1").Select
ActiveCell.FormulaR1C1 = "t02"
Range("AB2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],2)"
Range("AB2").Select
Selection.Copy
Range("AA2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("AD1").Select
ActiveCell.FormulaR1C1 = "p2t1"
Range("AD2").Select
ActiveCell.FormulaR1C1 = "=RC[-26]/RC[-24]"
Range("AD2").Select
Selection.Copy
Range("AC2").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
'change font and color in the end of work
Range("G1,H1,I1,J1,K1,L1,O1,R1,U1,X1,AA1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16756735
End With
Range("M1,P1,S1,V1,Y1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16765067
End With
Range("N1,Q1,T1,W1,Z1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10873253
End With
Range("AB1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 8519679
End With
Range("AD1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 7775700
End With
Range("A1").CurrentRegion.Select
With Selection.Font
.ColorIndex = xlAutomatic
End With
Range("A1").CurrentRegion.Select
With Selection.Font
.Name = "Tahoma"
.Size = 8
End With
Range("A1").CurrentRegion.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
End Sub
Last edited: