Just random mumbling

Tuesday, May 31, 2016

Professional Summary Sheet Creation code Excel VBA,Sourav Bhattacharya

Sub final()

Application.ScreenUpdating = False

Application.EnableEvents = False

Sheets("Summary").Select

Sheets("Summary").Name = "Sheet1"

Sheets("Sheet1").Select

Range("B38").Select

If ActiveCell.Value = "Total Orissa State" Then

ActiveCell.EntireRow.Delete

Else

End If

On Error Resume Next

test7

On Error Resume Next

test8

On Error Resume Next

test9

Sheets("Sheet1").Select

Range("D18").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C4:R123C27,MATCH(RC[-2],X!R5C2:R123C2,0)+1,FALSE),0)/IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C28:R123C39,MATCH(RC[-2],X!R5C2:R123C2,0)+1,FALSE),0),0)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C4:R123C27,MATCH(RC[-4],X!R5C2:R123C2,0)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,X!R4C4:R123C27,MATCH(RC[-4],X!R5C2:R123C2,0)+1,FALSE)-1,0)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C4:R123C27,MATCH(RC[-8],Z!R5C2:R123C2,0)+1,FALSE),0)/IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C28:R123C39,MATCH(RC[-8],Z!R5C2:R123C2,0)+1,FALSE),0),0)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C4:R123C27,MATCH(RC[-10],Z!R5C2:R123C2,0)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,Z!R4C4:R123C27,MATCH(RC[-10],Z!R5C2:R123C2,0)+1,FALSE)-1,0)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C4:R123C27,MATCH(RC[-14],Y!R5C2:R123C2,0)+1,FALSE),0)/IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C28:R123C39,MATCH(RC[-14],Y!R5C2:R123C2,0)+1,FALSE),0),0)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C4:R123C27,MATCH(RC[-16],Y!R5C2:R123C2,0)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,Y!R4C4:R123C27,MATCH(RC[-16],Y!R5C2:R123C2,0)+1,FALSE)-1,0)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Offset(18, -17).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, -1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, -1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, -1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 3).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, -2).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 3).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)"

ActiveCell.Offset(22, -17).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Offset(38, -17).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-38]C:R[-1]C)"

ActiveCell.Offset(25, -17).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, -5).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(-25, 0).Range("A1").Select

Selection.Copy

ActiveCell.Offset(25, 0).Range("A1").Select

ActiveSheet.Paste

ActiveCell.Offset(0, 1).Range("A1").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Select

ActiveCell.FormulaR1C1 = _

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveWorkbook.Save

Sheets("Sheet1").Select

Range("B18:U18").Select

With Selection.Interior

.PatternColorIndex = xlAutomatic

.Color = 65535

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Range("B37:U37").Select

With Selection.Interior

.PatternColorIndex = xlAutomatic

.Color = 65535

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Range("B59:U59").Select

With Selection.Interior

.PatternColorIndex = xlAutomatic

.Color = 65535

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Range("B98:U98").Select

With Selection.Interior

.PatternColorIndex = xlAutomatic

.Color = 65535

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Range("B123:U123").Select

With Selection.Interior

.PatternColorIndex = xlAutomatic

.Color = 65535

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Sheets("Sheet1").Select

Range("D5:F123").Select

'ActiveCell.EntireColumn.Select

Selection.Style = "Percent"

Range("J5:L123").Select

Selection.Style = "Percent"

Range("P5:R123").Select

Selection.Style = "Percent"

Sheets("Sheet1").Select

Range("B38").Select

If ActiveCell.Value <> "Total Orissa State" Then

Rows("38:38").Select

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

End If

Sheets("Sheet1").Select

Range("B38:C38").Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Selection.Merge

Range("B38:C38").Select

ActiveCell.FormulaR1C1 = "Total Orissa State"

Range("B38").Select

ActiveWorkbook.Save

'added for total orissa and grand total

Sheets("Sheet1").Select

Range("D38").Select

ActiveCell.FormulaR1C1 = _

Range("E38").Select

ActiveCell.FormulaR1C1 = "=(R[-1]C+R[-20]C)/2"

Range("F38").Select

ActiveCell.FormulaR1C1 = _

Range("G38").Select

ActiveCell.FormulaR1C1 = "=R[-20]C+R[-1]C"

Range("H38").Select

ActiveCell.FormulaR1C1 = "=R[-20]C+R[-1]C"

Range("I38").Select

ActiveCell.FormulaR1C1 = "=R[-20]C+R[-1]C"

Range("J38").Select

ActiveCell.FormulaR1C1 = _

Range("K38").Select

ActiveCell.FormulaR1C1 = "=(R[-1]C+R[-20]C)/2"

Range("L38").Select

ActiveCell.FormulaR1C1 = _

Range("M38").Select

ActiveCell.FormulaR1C1 = "=R[-20]C+R[-1]C"

Range("N38").Select

ActiveCell.FormulaR1C1 = "=R[-20]C+R[-1]C"

Range("O38").Select

ActiveCell.FormulaR1C1 = "=R[-20]C+R[-1]C"

Range("P38").Select

ActiveCell.FormulaR1C1 = _

Range("Q38").Select

ActiveCell.FormulaR1C1 = "=(R[-1]C+R[-20]C)/2"

Range("R38").Select

ActiveCell.FormulaR1C1 = _

Range("S38").Select

ActiveCell.FormulaR1C1 = "=R[-20]C+R[-1]C"

Range("T38").Select

ActiveCell.FormulaR1C1 = "=R[-20]C+R[-1]C"

Range("U38").Select

ActiveCell.FormulaR1C1 = "=R[-20]C+R[-1]C"

Range("U39").Select

Range("D124").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C4:R124C27,MATCH(""TOTAL X"",X!R5C2:R124C2,0)+1,FALSE),0)/IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C28:R124C39,MATCH(""TOTAL X"",X!R5C2:R124C2,0)+1,FALSE),0),0)"

Range("E124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("F124").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C4:R124C27,MATCH(""TOTAL X"",X!R5C2:R124C2,0)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,X!R4C4:R124C27,MATCH(""TOTAL X"",X!R5C2:R124C2,0)+1,FALSE)-1,0)"

Range("G124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("H124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("I124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("J124").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C4:R124C27,MATCH(""TOTAL Z"",Z!R5C2:R124C2,0)+1,FALSE),0)/IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C28:R124C39,MATCH(""TOTAL Z"",Z!R5C2:R124C2,0)+1,FALSE),0),0)"

Range("K124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("L124").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C4:R124C27,MATCH(RC[-10],Z!R5C2:R124C2,0)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,Z!R4C4:R124C27,MATCH(RC[-10],Z!R5C2:R124C2,0)+1,FALSE)-1,0)"

Range("M124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("N124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("O124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("P124").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C4:R124C27,MATCH(""TOTAL Y"",Y!R5C2:R124C2,0)+1,FALSE),0)/IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C28:R124C39,MATCH(""TOTAL Y"",Y!R5C2:R124C2,0)+1,FALSE),0),0)"

Range("Q124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("R124").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C4:R124C27,MATCH(""TOTAL Y"",Y!R5C2:R124C2,0)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,Y!R4C4:R124C27,MATCH(""TOTAL Y"",Y!R5C2:R124C2,0)+1,FALSE)-1,0)"

Range("S124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("T124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("U124").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+R[-26]C+R[-65]C+R[-87]C+R[-106]C"

Range("B38:U38").Select

With Selection.Interior

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorAccent6

.TintAndShade = -0.499984740745262

.PatternTintAndShade = 0

End With

Range("B124:U124").Select

With Selection.Interior

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorAccent5

.TintAndShade = 0.399975585192419

.PatternTintAndShade = 0

End With

'added for total orissa and grand total

'Final Touch

Range("B60:U60").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Range("B99:U99").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Range("B3:U124").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

Range("B3:U4").Select

Selection.Font.Bold = False

Selection.Font.Bold = True

Range("B18:U18").Select

Selection.Font.Bold = True

Range("B37:U37").Select

Selection.Font.Bold = True

Range("B38:U38").Select

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("B59:U59").Select

Selection.Font.Bold = True

Range("B98:U98").Select

Selection.Font.Bold = True

Range("B123:U124").Select

Selection.Font.Bold = True

Range("B3:U4").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlMedium

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlMedium

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlMedium

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlMedium

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

Range("B3:U4").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlNone

Selection.Borders(xlEdgeTop).LineStyle = xlNone

Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Selection.Borders(xlEdgeRight).LineStyle = xlNone

Selection.Borders(xlInsideVertical).LineStyle = xlNone

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Range("B3:U4").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlMedium

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlMedium

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlMedium

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlMedium

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

Range("B3:U4").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorLight2

.TintAndShade = -0.499984740745262

.PatternTintAndShade = 0

End With

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Sheets("Sheet1").Select

Range("B3:U4").Select

With Selection.Font

.ThemeColor = xlThemeColorAccent4

.TintAndShade = 0.799981688894314

End With

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorDark1

.TintAndShade = -0.149998474074526

.PatternTintAndShade = 0

End With

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorLight2

.TintAndShade = -0.249977111117893

.PatternTintAndShade = 0

End With

With Selection.Font

.ThemeColor = xlThemeColorLight2

.TintAndShade = 0.599993896298105

End With

With Selection.Font

.ThemeColor = xlThemeColorLight2

.TintAndShade = 0.799981688894314

End With

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0.599993896298105

.PatternTintAndShade = 0

End With

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorAccent1

.TintAndShade = -0.499984740745262

.PatternTintAndShade = 0

End With

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Sheets("Summary").Select

Range("B3:U4").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.ThemeColor = 1

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ThemeColor = 1

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ThemeColor = 1

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.ThemeColor = 1

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.ThemeColor = 1

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.ThemeColor = 1

.TintAndShade = 0

.Weight = xlThin

End With

Sheets("Sheet1").Select

Sheets("Sheet1").Name = "Summary"

Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub

Sub test7()

Dim tempuintu As Integer

Dim temppos As String

Dim tempint As Integer

Dim tempint2 As Integer

Dim k As Integer

Dim temppos2 As String

Dim l As Integer

l = 0

Dim m As Integer

m = 1

Dim q As Integer

q = 0

Application.DisplayAlerts = False

On Error Resume Next

ActiveWorkbook.Sheets("temp_data_2").Delete

ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "temp_data_2"

Sheets("Sheet1").Select

temppos = "C5"

temppos2 = temppos

Range(temppos).Select

While InStr(ActiveCell.Value, "Z") = 0

If InStr(ActiveCell.Value, "Total") <> 0 Then

'Sheets("X").Select

'Range(temppos2).Select

'k = 0

'While InStr(ActiveCell.Value, "Total") = 0

'k = k + 1

'ActiveCell.Offset(1, 0).Select

'Wend

'k = k + l + 4 + m

'm = m + 1

'l = l + k

'MsgBox (l)

q = 0

tempint = ActiveCell.Column + 1

tempint2 = ActiveCell.Row + 1

Sheets("temp_data_2").Select

Range("A1").Select

ActiveCell.Value = tempint

Range("A2").Select

ActiveCell.Value = tempint2

Range("A3").Select

ActiveCell.FormulaR1C1 = "=SUBSTITUTE(ADDRESS(1,R[-2]C,4),""1"","""")&R[-1]C"

temppos = ActiveCell.Value

'MsgBox (temppos)

Sheets("Sheet1").Select

Range(temppos).Select

temppos2 = temppos

'MsgBox (temppos2)

'firstcolnum = CInt((Range(selectedarea & 1).Column))

'special test

'special test end

Else

'testing start

If q = 0 Then

Sheets("X").Select

Range(temppos2).Select

While InStr(ActiveCell.Value, "Total") = 0

ActiveCell.Offset(1, 0).Select

Wend

k = ActiveCell.Row

'MsgBox (k)

End If

q = 1

Sheets("Sheet1").Select

Range(temppos).Select

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C4:R122C27,MATCH(RC[-1],X!R5C3:R122C3,0)+1,FALSE),0)/IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C28:R122C39,MATCH(RC[-1],X!R5C3:R122C3,0)+1,FALSE),0),0)"

Dim temp As Double

'MsgBox (temppos2)

'MsgBox (k)

Sheets("temp_data").Select

Range("A1").Select

On Error Resume Next

ActiveCell.FormulaR1C1 = _

"=MATCH(TEXT(Sheet1!R1C9,""mmm"")&""-""&TEXT(Sheet1!R1C9,""yy""),X!R[3]C[3]:R[3]C[26],0)+3"

ActiveCell.Offset(0, 1).Range("A1").Select

On Error Resume Next

ActiveCell.FormulaR1C1 = "=COLUMN(INDIRECT(""C6""))+RC[-1]"

ActiveCell.Offset(0, 1).Range("A1").Select

On Error Resume Next

ActiveCell.FormulaR1C1 = "=SUBSTITUTE(ADDRESS(1,RC[-2],4),""1"","""")"

ActiveCell.Offset(0, 1).Range("A1").Select

On Error Resume Next

ActiveCell.FormulaR1C1 = "=RC[-1] "

ActiveCell.Value = ActiveCell.Value & k

temp2 = ActiveCell.Value

Sheets("X").Select

Range(temp2).Select

temp = ActiveCell.Value

Sheets("temp_data").Select

Range("E1").Select

ActiveCell.Value = temp

Sheets("Sheet1").Select

Range(temppos).Select

ActiveCell.Offset(0, 2).Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C4:R122C27,MATCH(RC[-2],X!R5C3:R122C3,0)+1,FALSE),0)/ " & temp & " ,0)"

Range(temppos).Select

ActiveCell.Offset(0, 3).Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C4:R122C27,MATCH(RC[-3],X!R5C3:R122C3,0)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,X!R4C4:R122C27,MATCH(RC[-3],X!R5C3:R122C3,0)+1,FALSE)-1,0)"

'ActiveCell.FormulaR1C1 = _

"=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C4:R17C27,MATCH(RC[-3],X!R5C3:R17C3)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,X!R4C4:R17C27,MATCH(RC[-3],X!R5C3:R17C3)+1,FALSE)-1,0)"

Dim i As Integer

i = 1

Dim result As Long

result = 0

Dim str2 As String

Sheets("sheet1").Select

Range(temppos).Select

str2 = """" & ActiveCell.Value & """"

'MsgBox (str2)

For i = 0 To 2

Range(temppos).Select

ActiveCell.Offset(0, 4).Select

ActiveCell.FormulaR1C1 = _

        "=IFERROR(HLOOKUP(TEXT((IF((TEXT(R1C9,""mm"")- " & i & " )
        result = result + CInt(ActiveCell.Value)

        Next i
      Range(temppos).Select
    ActiveCell.Offset(0, 4).Select
    ActiveCell.Value = result

    Range(temppos).Select
    ActiveCell.Offset(0, 5).Select

    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),X!R4C4:R122C27,MATCH(RC[-5],X!R5C3:R122C3,0)+1,FALSE),0),0)"

      Range(temppos).Select
str2 = """" & ActiveCell.Value & """"
'MsgBox (str2)
result = 0
For i = 0 To 11
    Range(temppos).Select
    ActiveCell.Offset(0, 6).Select
   ActiveCell.FormulaR1C1 = _
        "=IFERROR(HLOOKUP(TEXT((IF((TEXT(R1C9,""mm"")- " & i & " )
        result = result + CInt(ActiveCell.Value)

        Next i

     Range(temppos).Select
    ActiveCell.Offset(0, 6).Select
    ActiveCell.Value = result

'end action

'testing done
Range(temppos).Select

ActiveCell.Offset(1, 0).Select

temppos = Replace(ActiveCell.Address, "$", "")

End If

Wend
'MsgBox (ActiveCell.Address)

End Sub

Sub test8()
'New

'End New

Dim tempuintu As Integer

Dim temppos As String
Dim tempint As Integer
Dim tempint2 As Integer
Dim k As Integer
Dim temppos2 As String
Dim l As Integer
l = 0
Dim m As Integer
m = 1

Dim q As Integer
q = 0

Application.DisplayAlerts = False

     On Error Resume Next
ActiveWorkbook.Sheets("temp_data_2").Delete
ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "temp_data_2"

Sheets("Sheet1").Select
temppos = "C5"
temppos2 = temppos

Range(temppos).Select
While InStr(ActiveCell.Value, "Z") = 0

If InStr(ActiveCell.Value, "Total") <> 0 And InStr(ActiveCell.Value, "Orissa") = 0 Then

'Sheets("Z").Select
'Range(temppos2).Select

'k = 0
'While InStr(ActiveCell.Value, "Total") = 0
'k = k + 1
'ActiveCell.Offset(1, 0).Select

'Wend
'k = k + l + 4 + m

'm = m + 1

'l = l + k

'MsgBox (l)

'New Part

'End New
q = 0

tempint = ActiveCell.Column + 1
tempint2 = ActiveCell.Row + 1

Sheets("temp_data_2").Select
Range("A1").Select
ActiveCell.Value = tempint
Range("A2").Select
ActiveCell.Value = tempint2
Range("A3").Select
ActiveCell.FormulaR1C1 = "=SUBSTITUTE(ADDRESS(1,R[-2]C,4),""1"","""")&R[-1]C"
temppos = ActiveCell.Value

'MsgBox (temppos)
Sheets("Sheet1").Select
Range(temppos).Select
temppos2 = temppos
'MsgBox (temppos2)

'firstcolnum = CInt((Range(selectedarea & 1).Column))
'special test

'special test end

Else

'testing start

If q = 0 Then

Sheets("Z").Select
Range(temppos2).Select

While InStr(ActiveCell.Value, "Total") = 0

ActiveCell.Offset(1, 0).Select

Wend
k = ActiveCell.Row
'MsgBox (k)

End If

q = 1

Sheets("Sheet1").Select
Range(temppos).Select

ActiveCell.Offset(0, 7).Select

ActiveCell.FormulaR1C1 = _
        "=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C4:R122C27,MATCH(RC[-7],Z!R5C3:R122C3,0)+1,FALSE),0)/IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C28:R122C39,MATCH(RC[-7],Z!R5C3:R122C3,0)+1,FALSE),0),0)"

Dim temp As Double

'MsgBox (temppos2)

'MsgBox (k)

Sheets("temp_data").Select

   Range("A1").Select
   On Error Resume Next

    ActiveCell.FormulaR1C1 = _
        "=MATCH(TEXT(Sheet1!R1C9,""mmm"")&""-""&TEXT(Sheet1!R1C9,""yy""),Z!R[3]C[3]:R[3]C[26],0)+3"

   ActiveCell.Offset(0, 1).Range("A1").Select
   On Error Resume Next

    ActiveCell.FormulaR1C1 = "=COLUMN(INDIRECT(""C6""))+RC[-1]"
    ActiveCell.Offset(0, 1).Range("A1").Select
On Error Resume Next
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(ADDRESS(1,RC[-2],4),""1"","""")"

    ActiveCell.Offset(0, 1).Range("A1").Select



    On Error Resume Next
    ActiveCell.FormulaR1C1 = "=RC[-1] "
   ActiveCell.Value = ActiveCell.Value & k

temp2 = ActiveCell.Value
Sheets("Z").Select
Range(temp2).Select
temp = ActiveCell.Value
Sheets("temp_data").Select
Range("E1").Select
ActiveCell.Value = temp
Sheets("Sheet1").Select
Range(temppos).Select

ActiveCell.Offset(0, 8).Select

   ActiveCell.FormulaR1C1 = _
        "=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C4:R122C27,MATCH(RC[-8],Z!R5C3:R122C3,0)+1,FALSE),0)/ " & temp & " ,0)"
Range(temppos).Select

ActiveCell.Offset(0, 9).Select
ActiveCell.FormulaR1C1 = _
        "=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C4:R122C27,MATCH(RC[-9],Z!R5C3:R122C3,0)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,Z!R4C4:R122C27,MATCH(RC[-9],Z!R5C3:R122C3,0)+1,FALSE)-1,0)"
'ActiveCell.FormulaR1C1 = _
        "=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C4:R17C27,MATCH(RC[-3],Z!R5C3:R17C3)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,Z!R4C4:R17C27,MATCH(RC[-3],Z!R5C3:R17C3)+1,FALSE)-1,0)"

        Dim i As Integer
i = 1
Dim result As Long

result = 0
Dim str2 As String
Sheets("sheet1").Select

Range(temppos).Select
str2 = """" & ActiveCell.Value & """"
'MsgBox (str2)

For i = 0 To 2
    Range(temppos).Select
    ActiveCell.Offset(0, 10).Select

   ActiveCell.FormulaR1C1 = _
        "=IFERROR(HLOOKUP(TEXT((IF((TEXT(R1C9,""mm"")- " & i & " )
        result = result + CInt(ActiveCell.Value)

        Next i
      Range(temppos).Select
    ActiveCell.Offset(0, 10).Select
    ActiveCell.Value = result

    Range(temppos).Select
    ActiveCell.Offset(0, 11).Select

    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Z!R4C4:R122C27,MATCH(RC[-11],Z!R5C3:R122C3,0)+1,FALSE),0),0)"

      Range(temppos).Select
str2 = """" & ActiveCell.Value & """"
'MsgBox (str2)
result = 0
For i = 0 To 11
    Range(temppos).Select
    ActiveCell.Offset(0, 12).Select
   ActiveCell.FormulaR1C1 = _
        "=IFERROR(HLOOKUP(TEXT((IF((TEXT(R1C9,""mm"")- " & i & " )
        result = result + CInt(ActiveCell.Value)

        Next i

     Range(temppos).Select
    ActiveCell.Offset(0, 12).Select
    ActiveCell.Value = result

'end action

'testing done
Range(temppos).Select

ActiveCell.Offset(1, 0).Select

temppos = Replace(ActiveCell.Address, "$", "")

End If

Wend
'MsgBox (ActiveCell.Address)

End Sub

Sub test9()

Dim tempuintu As Integer

Dim temppos As String
Dim tempint As Integer
Dim tempint2 As Integer
Dim k As Integer
Dim temppos2 As String
Dim l As Integer
l = 0
Dim m As Integer
m = 1

Dim q As Integer
q = 0

Application.DisplayAlerts = False

     On Error Resume Next
ActiveWorkbook.Sheets("temp_data_2").Delete
ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "temp_data_2"

Sheets("Sheet1").Select
temppos = "C5"
temppos2 = temppos

Range(temppos).Select
While InStr(ActiveCell.Value, "Z") = 0

If InStr(ActiveCell.Value, "Total") <> 0 Then
'Sheets("Y").Select
'Range(temppos2).Select

'k = 0
'While InStr(ActiveCell.Value, "Total") = 0
'k = k + 1
'ActiveCell.Offset(1, 0).Select

'Wend
'k = k + l + 4 + m

'm = m + 1

'l = l + k

'MsgBox (l)
q = 0

tempint = ActiveCell.Column + 1
tempint2 = ActiveCell.Row + 1

Sheets("temp_data_2").Select
Range("A1").Select
ActiveCell.Value = tempint
Range("A2").Select
ActiveCell.Value = tempint2
Range("A3").Select
ActiveCell.FormulaR1C1 = "=SUBSTITUTE(ADDRESS(1,R[-2]C,4),""1"","""")&R[-1]C"
temppos = ActiveCell.Value

'MsgBox (temppos)
Sheets("Sheet1").Select
Range(temppos).Select
temppos2 = temppos
'MsgBox (temppos2)

'firstcolnum = CInt((Range(selectedarea & 1).Column))
'special test

'special test end

Else

'testing start

If q = 0 Then

Sheets("Y").Select
Range(temppos2).Select

While InStr(ActiveCell.Value, "Total") = 0

ActiveCell.Offset(1, 0).Select

Wend
k = ActiveCell.Row
'MsgBox (k)

End If

q = 1

Sheets("Sheet1").Select
Range(temppos).Select

ActiveCell.Offset(0, 13).Select

ActiveCell.FormulaR1C1 = _
        "=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C4:R122C27,MATCH(RC[-13],Y!R5C3:R122C3,0)+1,FALSE),0)/IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C28:R122C39,MATCH(RC[-13],Y!R5C3:R122C3,0)+1,FALSE),0),0)"

Dim temp As Double

'MsgBox (temppos2)

'MsgBox (k)

Sheets("temp_data").Select

   Range("A1").Select
   On Error Resume Next

    ActiveCell.FormulaR1C1 = _
        "=MATCH(TEXT(Sheet1!R1C9,""mmm"")&""-""&TEXT(Sheet1!R1C9,""yy""),Y!R[3]C[3]:R[3]C[26],0)+3"

   ActiveCell.Offset(0, 1).Range("A1").Select
   On Error Resume Next

    ActiveCell.FormulaR1C1 = "=COLUMN(INDIRECT(""C6""))+RC[-1]"
    ActiveCell.Offset(0, 1).Range("A1").Select
On Error Resume Next
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(ADDRESS(1,RC[-2],4),""1"","""")"

    ActiveCell.Offset(0, 1).Range("A1").Select



    On Error Resume Next
    ActiveCell.FormulaR1C1 = "=RC[-1] "
   ActiveCell.Value = ActiveCell.Value & k

temp2 = ActiveCell.Value
Sheets("Y").Select
Range(temp2).Select
temp = ActiveCell.Value
Sheets("temp_data").Select
Range("E1").Select
ActiveCell.Value = temp
Sheets("Sheet1").Select
Range(temppos).Select

ActiveCell.Offset(0, 14).Select

   ActiveCell.FormulaR1C1 = _
        "=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C4:R122C27,MATCH(RC[-14],Y!R5C3:R122C3,0)+1,FALSE),0)/ " & temp & " ,0)"
Range(temppos).Select

ActiveCell.Offset(0, 15).Select
ActiveCell.FormulaR1C1 = _
        "=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C4:R122C27,MATCH(RC[-15],Y!R5C3:R122C3,0)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,Y!R4C4:R122C27,MATCH(RC[-15],Y!R5C3:R122C3,0)+1,FALSE)-1,0)"
'ActiveCell.FormulaR1C1 = _
        "=IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C4:R17C27,MATCH(RC[-3],Y!R5C3:R17C3)+1,FALSE)/HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy"")-1,Y!R4C4:R17C27,MATCH(RC[-3],Y!R5C3:R17C3)+1,FALSE)-1,0)"

        Dim i As Integer
i = 1
Dim result As Long

result = 0
Dim str2 As String
Sheets("sheet1").Select

Range(temppos).Select
str2 = """" & ActiveCell.Value & """"
'MsgBox (str2)

For i = 0 To 2
    Range(temppos).Select
    ActiveCell.Offset(0, 16).Select

   ActiveCell.FormulaR1C1 = _
        "=IFERROR(HLOOKUP(TEXT((IF((TEXT(R1C9,""mm"")- " & i & " )
        result = result + CInt(ActiveCell.Value)

        Next i
      Range(temppos).Select
    ActiveCell.Offset(0, 16).Select
    ActiveCell.Value = result

    Range(temppos).Select
    ActiveCell.Offset(0, 17).Select

    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IFERROR(HLOOKUP(TEXT(R1C9,""mmm"")&""-""&TEXT(R1C9,""yy""),Y!R4C4:R122C27,MATCH(RC[-17],Y!R5C3:R122C3,0)+1,FALSE),0),0)"

      Range(temppos).Select
str2 = """" & ActiveCell.Value & """"
'MsgBox (str2)
result = 0
For i = 0 To 11
    Range(temppos).Select
    ActiveCell.Offset(0, 18).Select
   ActiveCell.FormulaR1C1 = _
        "=IFERROR(HLOOKUP(TEXT((IF((TEXT(R1C9,""mm"")- " & i & " )
        result = result + CInt(ActiveCell.Value)

        Next i

     Range(temppos).Select
    ActiveCell.Offset(0, 18).Select
    ActiveCell.Value = result

'end action

'testing done
Range(temppos).Select

ActiveCell.Offset(1, 0).Select

temppos = Replace(ActiveCell.Address, "$", "")

End If

Wend
'MsgBox (ActiveCell.Address)

End Sub

Tuesday, May 24, 2016

Summary Report Automation by vba Sourav Bhattacharya

Sub firstone()
     Application.DisplayAlerts = False

     On Error Resume Next
ActiveWorkbook.Sheets("Sheet1").Delete
ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Sheet1"
'heading

    Sheets("Sheet1").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "State"

    Columns("A:A").EntireColumn.AutoFit
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Unit Head"
        Columns("B:B").EntireColumn.AutoFit
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Total No. Of Dealers"

    Columns("C:C").EntireColumn.AutoFit
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "No. Of Dealers Billed Dsp This Month"

    Columns("D:D").EntireColumn.AutoFit


    Range("E1").Select
    ActiveCell.FormulaR1C1 = "No. of Dealers Not Billed DSP This Month(A)"

    Columns("E:E").EntireColumn.AutoFit
    Range("F1").Select
    ActiveCell.FormulaR1C1 = _
        "No. of Dealer who build DSP Last month but not this month(B)"

    Columns("F:F").EntireColumn.AutoFit
    Range("G1").Select


    ActiveCell.FormulaR1C1 = _
        "No. of Dealer whose Trade Volume is higher than State Avg but DSP contribution % is less than Stae Avg(C)"

    Columns("G:G").EntireColumn.AutoFit

    'heading end


     Dim source As Range
     Dim nCol As Integer
     Dim nRow As Integer
     Dim tempstr As String
     Dim str As String

      Sheets("Sheet1").Select
    Range("A2:XFD104856").Select

    Selection.Clear

     Dim k As Integer

On Error Resume Next
ActiveWorkbook.Sheets("temp_data").Delete
ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "temp_data"
ActiveWorkbook.Sheets("Total No. of Dlrs").Select

    Range("A1").Select
    On Error Resume Next

    ActiveSheet.ShowAllData
     Range("A1").Select

   If ActiveSheet.AutoFilterMode Then
   Selection.AutoFilter
   End If


Dim temppos As String
temppos = "B2"

Sheets("Total No. of Dlrs").Select

    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("temp_data").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").EntireColumn.AutoFit
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$A$3473").RemoveDuplicates Columns:=1, Header:=xlNo

    Dim i As Integer
Dim j As Integer
Dim pos As String
Dim filterrange As String

'
    Sheets("temp_data").Select
    Range("A1").Select

    Selection.Copy
    Range("B1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
j = (Selection.Rows.Count) - 1

    Range("A1").Select

    For i = 1 To j

    pos = ActiveCell.Offset(i, 0).Address
    Range(pos).Select

    Selection.Copy
     Range("B2").Select
    ActiveSheet.Paste
   ActiveWorkbook.Sheets("Total No. of Dlrs").Select
   On Error Resume Next
    ActiveSheet.ShowAllData

    Range("A1").Select

   If ActiveSheet.AutoFilterMode Then
   Selection.AutoFilter

   End If

    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    filterrange = Selection.Address
       Range(filterrange).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("temp_data").Range("B1:B2"), Unique:=False
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

    ActiveWorkbook.Sheets("Sheet1").Select
    Range(temppos).Select

    ActiveSheet.Paste
    Range(temppos).Select
    Range(Selection, Selection.End(xlDown)).Select
   Selection.RemoveDuplicates Columns:=1, Header:=xlNo
       Range(temppos).Select
       Range(Selection, Selection.End(xlDown)).Select
       For k = 1 To Selection.Rows.Count
       If ActiveCell.Value = "NA" Then


       ActiveCell.EntireRow.Delete
       Else
       ActiveCell.Offset(1, 0).Select


           End If





       Next k

        Sheets("temp_data").Select
    Range("B2").Select
     Selection.Copy


        Sheets("Sheet1").Select
         Range(temppos).Select
         ActiveCell.Offset(0, -1).Select
         ActiveSheet.Paste
         str = ActiveCell.Value

          Range(temppos).Select
           Selection.End(xlDown).Select
           ActiveCell.Offset(0, -1).Select
           ActiveCell.Offset(1, 0).Select
            ActiveCell.Value = "Total " & str

           ActiveCell.Resize(1, 2).Select


    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge


           ActiveCell.Offset(-1, 0).Select

           While ActiveCell.Value = ""
           ActiveCell.Value = str

           ActiveCell.Offset(-1, 0).Select



           Wend
           'test
            Range(temppos).Select
             ActiveCell.Offset(0, 1).Select
           While ActiveCell.Offset(0, -1).Value <> ""

           ActiveCell.FormulaR1C1 = _
        "=COUNTIFS('Total No. of Dlrs'!C[-2],Sheet1!RC[-2],'Total No. of Dlrs'!C[3],Sheet1!RC[-1])"


           ActiveCell.Offset(1, 0).Select


           Wend
            Range(temppos).Select
             ActiveCell.Offset(0, 2).Select
             While ActiveCell.Offset(0, -2).Value <> ""
            ActiveCell.FormulaR1C1 = _
        "=COUNTIFS('No. of dlrs billed in CM'!C[-3],Sheet1!RC[-3],'No. of dlrs billed in CM'!C[2],Sheet1!RC[-2])"
           ActiveCell.Offset(1, 0).Select


           Wend
            Range(temppos).Select
             ActiveCell.Offset(0, 3).Select
             While ActiveCell.Offset(0, -3).Value <> ""
            ActiveCell.FormulaR1C1 = _
        "=COUNTIFS('No. of dlrs not billed in CM'!C[-4],Sheet1!RC[-4],'No. of dlrs not billed in CM'!C[1],Sheet1!RC[-3])"
          ActiveCell.Offset(1, 0).Select


           Wend
            Range(temppos).Select
             ActiveCell.Offset(0, 4).Select
             While ActiveCell.Offset(0, -4).Value <> ""

            ActiveCell.FormulaR1C1 = _
        "=COUNTIFS('No of dlrs bild LM nt CM'!C[-5],Sheet1!RC[-5],'No of dlrs bild LM nt CM'!C,Sheet1!RC[-4])"
           'test complete

        ActiveCell.Offset(1, 0).Select
        Wend
        Range(temppos).Select
             ActiveCell.Offset(0, 5).Select
             While ActiveCell.Offset(0, -5).Value <> ""
        ActiveCell.FormulaR1C1 = _
        "=COUNTIFS('Dlrs abv avg less than dsp%-UH'!C[-6],Sheet1!RC[-6],'Dlrs abv avg less than dsp%-UH'!C[-1],Sheet1!RC[-5])"
          ActiveCell.Offset(1, 0).Select
        Wend

         ' Range(temppos).Select
          '   Selection.End(xlDown).Select

           ' ActiveCell.Offset(1, 0).Select
            ' ActiveCell.Value = "Total"





          Range(temppos).Select

        ' ActiveCell.Value = ActiveCell.Offset(-1, 0).Value & " Total"

          ActiveCell.Offset(0, 1).Select
            Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select

    Set source = Selection

    nCol = source.Columns.Count
    nRow = source.Rows.Count
    For iCol = 1 To nCol
        With source.Columns(iCol).Rows(nRow).Offset(1, 0)
            .FormulaR1C1 = "=SUM(R[-" & nRow & "]C:R[-1]C)"
            .Font.Bold = True
        End With
    Next iCol


       Range(temppos).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(2, 0).Select
    temppos = ActiveCell.Address


     ActiveWorkbook.Sheets("Total No. of Dlrs").Select

    Range("A1").Select
    On Error Resume Next

    ActiveSheet.ShowAllData
     Range("A1").Select

   If ActiveSheet.AutoFilterMode Then
   Selection.AutoFilter
   End If

     Sheets("temp_data").Select
    Range("A1").Select
    Next i
ActiveSheet.Columns("A:A").EntireColumn.AutoFit
Application.CutCopyMode = False

Sheets("Sheet1").Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
For i = 1 To 15000

If InStr(ActiveCell.Value, "Total") Then
If ActiveCell.Offset(1, 0).Value = "" Then
Exit For
End If
End If

ActiveCell.Offset(1, 0).Select

Next i

   ActiveCell.Offset(1, 0).Select
            ActiveCell.Value = "Grand Total"

           ActiveCell.Resize(1, 2).Select


    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge

    Dim sourcefinal As Range

Dim count1 As Integer

Sheets("Sheet1").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    count1 = Selection.Rows.Count
' MsgBox (count1)

On Error Resume Next
ActiveWorkbook.Sheets("temp_data").Delete
ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "temp_data"
Dim temporarystr As String
temporarystr = "A1"

Sheets("Sheet1").Select

Range("A1").Select

For i = 1 To count1 - 1

If InStr(ActiveCell.Value, "Total") <> 0 Then

ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(0, -1).Select
ActiveWorkbook.Sheets("temp_data").Select
Range(temporarystr).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

ActiveCell.Offset(1, 0).Select
temporarystr = ActiveCell.Address
Sheets("Sheet1").Select

End If
Range("A1").Select
ActiveCell.Offset(i, 0).Select

Next i
ActiveWorkbook.Sheets("temp_data").Select
Range("A1").Select
   Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
       Set sourcefinal = Selection

    nCol = sourcefinal.Columns.Count
    nRow = sourcefinal.Rows.Count
    For iCol = 1 To nCol
        With sourcefinal.Columns(iCol).Rows(nRow).Offset(1, 0)
            .FormulaR1C1 = "=SUM(R[-" & nRow & "]C:R[-1]C)"
            .Font.Bold = True
        End With
    Next iCol
    Range("a" & nRow + 1).Select
       Range(Selection, Selection.End(xlToRight)).Select
       Selection.Copy
       Sheets("Sheet1").Select
Range("A" & count1).Select
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

   Columns("A:F").EntireColumn.AutoFit

    'Design
Sheets("Sheet1").Select
Cells.Select

    Selection.ClearFormats
    Application.CutCopyMode = False

Range("A1").Select

Dim tempu As String
tempu = "A1"

Dim tempu2 As String

For i = 1 To count1 - 1

If InStr(ActiveCell.Value, "Total") <> 0 Then

Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
tempu2 = Replace(ActiveCell.Address, "$", "") & ":" & Replace(tempu, "$", "")
Range(tempu2).Select
With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
     .Bold = True
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
Range(tempu).Select

ActiveCell.Offset(1, 0).Select
tempu = ActiveCell.Address

Next i
Range("A1").Select

'Design end

'Header Design

    Sheets("Sheet1").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:1").RowHeight = 42.75
    With Selection.Font
        .Name = "Calibri"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor

    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With

'Header Design End

   On Error Resume Next
ActiveWorkbook.Sheets("temp_data").Delete

End Sub

Saturday, April 30, 2016

filter data and find count and sum using vba,Sourav Bhattacharya ,Excel VBA Teacher

Sub setlistbox()

Workbooks("Macro_1.xlsm").Activate
ActiveWorkbook.Sheets("DATABASE").Activate
    Range("AJ3").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove

    Range("AI3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AJ3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("AJ3").Select

    Dim myrange As Range
    Range(Selection, Selection.End(xlDown)).Select
    Set myrange = Selection
    'MsgBox (myrange.Address)

    ActiveSheet.Range(myrange.Address).RemoveDuplicates Columns:=1, Header:=xlNo

    Range("AJ3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Dim options() As String
    ReDim options(Selection.Rows.count) As String
     Dim cell As Object
    Dim count As Integer
    count = 1
    For Each cell In Selection
        options(count) = cell.Value
        count = count + 1

    Next cell
    'MsgBox Selection.Rows.count
    For count = 1 To UBound(options)
    'MsgBox (options(count))
    Next count



    ActiveCell.EntireColumn.Delete
    ActiveWorkbook.Sheets("2nd Macro").Activate
    Columns("B:B").Select
    Selection.NumberFormat = "@"

    Range("B6").Select
    For i = 1 To UBound(options)
Sheet2.ListBox1.AddItem options(i)

Next i

End Sub

Sub almostfinal()
Dim countarr() As Integer

Dim str1 As String

Workbooks("Macro_1.xlsm").Activate

ActiveWorkbook.Sheets("2nd Macro").Activate

    Range("B6:C200").Select
    Selection.Clear

    Range("C1:AG1500").Select
    Selection.Clear

   Dim source As Range
    Dim iCol As Long
    Dim nCol As Long
    Dim nRow As Long
'Dim text As String
Dim count1 As Integer
Dim i As Integer
Dim j As Integer

count1 = 0
   Sheets("2nd Macro").Select
    Columns("B:B").Select
    Selection.NumberFormat = "@"

Range("B6").Select

    For i = 0 To Sheet2.ListBox1.ListCount - 1
        If Sheet2.ListBox1.Selected(i) = True Then
       ActiveCell.Value = Sheet2.ListBox1.List(i)
       ActiveCell.Offset(1, 0).Select
       count1 = count1 + 1

        End If
    Next i
   ' MsgBox (count1)
   If count1 = 0 Then
    Range("B6").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
     Range("B6:C200").Select
    Selection.Clear

    Range("C1:AG1500").Select
    Selection.Clear

    Exit Sub

    End If


   ' MsgBox "Selected items are: " & text
     Columns("B:B").EntireColumn.AutoFit

     Application.DisplayAlerts = False
On Error Resume Next
Sheets("temp_data").Delete

Worksheets.Add(After:=Worksheets(Worksheets.count)).Name = "temp_data"

ActiveWorkbook.Sheets("temp_data").Select

    Columns("A:A").Select
    Selection.NumberFormat = "@"

ActiveWorkbook.Sheets("2nd Macro").Activate
Range("B5").Select
Dim pos1 As String
Dim filterstr As String
ReDim countarr(count1) As Integer

For i = 1 To count1


Range("B5").Select
    Sheets("temp_data").Select
    Range("B1").Select
    Dim signal As Integer
    signal = 0



ActiveWorkbook.Sheets("2nd Macro").Activate
Range("B5").Select
For j = 1 To i

   ActiveCell.Offset(1, 0).Select


Next j

pos1 = ActiveCell.Address
' MsgBox ("pos1" & pos1)

    Range("B5").Select

ActiveCell.Offset(0, 1).Select
ActiveCell.EntireColumn.Insert
    Range("B5").Select
    Selection.Copy
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range(pos1).Select


    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(0, 1).Select
    pos2 = ActiveCell.Address
   ' MsgBox ("pos2" & pos2)

    Range(pos2).Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   ' MsgBox ("check")

        Range("C5").Select
        str1 = "$c$5:"

        For j = 1 To count1
        ActiveCell.Offset(1, 0).Select


        Next j

        str1 = str1 & ActiveCell.Address

    Range(str1).Select
    Selection.Copy
    ActiveWorkbook.Sheets("temp_data").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").EntireColumn.AutoFit
    Range("a2").Select
    For j = 1 To count1
    If ActiveCell.Value <> "" Then
Range("a2").Value = ActiveCell.Value

    End If
    ActiveCell.Offset(1, 0).Select

    Next j

' Columns("A:A").Select
' Selection.SpecialCells(xlCellTypeBlanks).Select
'    Selection.EntireRow.Delete

    'now the filtering part
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$A$" & 100).RemoveDuplicates Columns:=1, Header:=xlYes
       ActiveWorkbook.Sheets("DATABASE").Select
     Range("A2:AI100").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("temp_data").Range("A1:A2"), Unique:=False

    Range("I2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("temp_data").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        'filtering ends

     Range("B1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select

countarr(i) = (Selection.Rows.count)

    Set source = Selection

    nCol = source.Columns.count
    nRow = source.Rows.count
    For iCol = 1 To nCol
        With source.Columns(iCol).Rows(nRow).Offset(1, 0)
            .FormulaR1C1 = "=SUM(R[-" & nRow & "]C:R[-1]C)"
            .Font.Bold = True
        End With
    Next iCol

     Sheets("temp_data").Select
    Range("B1").Select
    Selection.End(xlDown).Select
    Range(Selection, Selection.End(xlToRight)).Select

    Selection.Copy

     Sheets("2nd Macro").Select
    Range(pos2).Select
    ActiveCell.Offset(0, 5).Select

    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      ActiveWorkbook.Sheets("2nd Macro").Activate
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
      ActiveWorkbook.Sheets("DATABASE").Activate
       Range("A3").Select
    ActiveSheet.ShowAllData

      ActiveWorkbook.Sheets("temp_data").Activate
      Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Clear
Next i
    ActiveWorkbook.Sheets("2nd Macro").Activate
    Range("c5").Select
    ActiveCell.Value = "count"
    ActiveCell.Offset(1, 0).Select

For i = 1 To count1
ActiveCell.Value = countarr(i) - 1
ActiveCell.Offset(1, 0).Select

Next i
For i = 1 To count1
countarr(i) = 0
Next i

   Sheets("DATABASE").Select
    Range("I2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("2nd Macro").Select
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False


End Sub

Sub testpos()

Workbooks("Macro_1.xlsm").Activate

ActiveWorkbook.Sheets("2nd Macro").Activate
Dim j As Integer
Dim i As Integer

For i = 1 To 4
Range("B5").Select
For j = 1 To i

' MsgBox (ActiveCell.Address)
   ActiveCell.Offset(1, 0).Select


Next j
MsgBox (ActiveCell.Address)
Next i

End Sub