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

Monday, April 25, 2016

My stupid advanced filter(with some cool features) macro,Sourav Excel Teacher

Public blankcell As String
Sub starttimer(colnum As Integer, rownum As Integer, param As String, firstpart As String, sheetname As String, temppos As String)

Application.OnTime Now + TimeValue("00:00:01"), "'increment_count_by_1 """ & colnum & """,""" & rownum & """,""" & param & """,""" & firstpart & """,""" & sheetname & """,""" & temppos & "'"

End Sub
Sub increment_count_by_1(colnum As Integer, rownum As Integer, param As String, firstpart As String, sheetname As String, temppos As String)

Call starttimer(colnum, rownum, param, firstpart, sheetname, temppos)
Range(blankcell).Value = CInt(Range(blankcell).Value) + 1

If CInt(Range(blankcell).Value) = 20 Then

Call endtimer(colnum, rownum, param, firstpart, sheetname, temppos)

End If

End Sub

Sub endtimer(colnum As Integer, rownum As Integer, param As String, firstpart As String, sheetname As String, temppos As String)
Application.OnTime Now + TimeValue("00:00:01"), "'increment_count_by_1 """ & colnum & """,""" & rownum & """,""" & param & """,""" & firstpart & """,""" & sheetname & """,""" & temppos & "'", schedule:=False
Range(blankcell).Value = ""
Call samesheetdellcellsetup(colnum, rownum, firstpart, sheetname, temppos)
Call repaintsheet(firstpart)

End Sub

Sub message(colnum As Integer, rownum As Integer, param As String, firstpart As String, sheetname As String, temppos As String)
Call samesheetcellsetup(colnum, rownum, param, firstpart, sheetname, temppos)
MsgBox ("this will be shown for 20 seconds")
findblankcell

Range(blankcell).Value = 0
Call increment_count_by_1(colnum, rownum, param, firstpart, sheetname, temppos)

End Sub

Sub findblankcell()

Dim ws As Worksheet

Set ws = Sheets("sheet1")

Dim colnum As Integer
colnum = (Range("A1").Column)
For Each cell In ws.Columns(colnum).Cells

If IsEmpty(cell) = True Then cell.Select: Exit For
Next cell
blankcell = ActiveCell.Address

End Sub

Sub test1()
Dim sheetname As String
Dim i As Long

Dim j As Long
Dim selectlookup As Range

Dim temppos As String
temppos = "a1"

Dim selectrange As Range
Dim selectedarea As String
Set selectrange = Application.InputBox(prompt:="select the cells for the range", Type:=8)
selectedarea = selectrange.Address
'MsgBox (selectedarea)
Dim selectedarea2 As String
selectedarea2 = Replace(selectedarea, "$", "")
'MsgBox (selectedarea2)
Dim firstpart As String
firstpart = Left(selectedarea2, InStr(selectedarea2, ":") - 1)
'MsgBox (firstpart)
Dim colnum1 As Integer
colnum1 = (Range(firstpart).Column)
'MsgBox (colnum1)

Dim lastpart As String
lastpart = Right(selectedarea2, (Len(selectedarea2) - Len(firstpart)) - 1)
'MsgBox (lastpart)
Dim colnum2 As Integer
colnum2 = (Range(lastpart).Column)
'MsgBox (colnum2)
Dim colnum As Integer
colnum = (colnum2 - colnum1) + 1
Dim rownum As Integer
Dim rownumholder As String
rownumholder = ""

For i = (InStr(selectedarea2, ":") + 1) To Len(selectedarea2)
If IsNumeric(Mid(selectedarea2, i, 1)) Then
rownumholder = rownumholder + Mid(selectedarea2, i, 1)
Else

End If

Next i
'MsgBox (rownumholder)
rownum = CInt(rownumholder)
'MsgBox ("colnum is : " & colnum & " rownum is : " & rownum)

'Dim arr1(3, 2) As Integer
Dim arr1() As String

ReDim arr1(colnum, rownum) As String

Sheets("sheet1").Select

Range(firstpart).Select

Dim pos As String

For i = 1 To rownum
For j = 1 To colnum
arr1(j, i) = (ActiveCell.Value)

ActiveCell.Offset(0, 1).Select

Next j

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

ActiveCell.Offset(0, -1).Select

Next j

Next i
For i = 1 To rownum
For j = 1 To colnum
'MsgBox (arr1(j, i))

Next j

Next i

'MsgBox (" number of columns in the 2d array " & UBound(arr1, 1))
'MsgBox (" number of rows in the 2d array " & UBound(arr1, 2))

Dim i2 As Long

Dim j2 As Long
Dim selectlookup2 As Range
Dim result As Integer
result = 0

Dim selectrange2 As Range

Set selectrange2 = Application.InputBox(prompt:="select the cells for the criterias", Type:=8)
selectedarea2 = selectrange2.Address
'MsgBox (selectedarea)
Dim selectedarea22 As String
selectedarea22 = Replace(selectedarea2, "$", "")
'MsgBox (selectedarea2)
Dim firstpart2 As String
firstpart2 = Left(selectedarea22, InStr(selectedarea22, ":") - 1)
'MsgBox (firstpart)
Dim colnum12 As Integer
colnum12 = (Range(firstpart2).Column)
'MsgBox (colnum1)

Dim lastpart2 As String
lastpart2 = Right(selectedarea22, (Len(selectedarea22) - Len(firstpart2)) - 1)
'MsgBox (lastpart)
Dim colnum22 As Integer
colnum22 = (Range(lastpart2).Column)
'MsgBox (colnum2)
Dim colnum225 As Integer
colnum225 = (colnum22 - colnum12) + 1
Dim rownum2 As Integer
Dim rownumholder2 As String
rownumholder2 = ""

For i = (InStr(selectedarea22, ":") + 1) To Len(selectedarea22)
If IsNumeric(Mid(selectedarea22, i, 1)) Then
rownumholder2 = rownumholder2 + Mid(selectedarea22, i, 1)
Else

End If

Next i
'MsgBox (rownumholder)
rownum2 = CInt(rownumholder2)
'MsgBox ("colnum is : " & colnum & " rownum is : " & rownum)

'Dim arr1(3, 2) As Integer
Dim arr2() As String

ReDim arr2(colnum225, rownum2) As String

Sheets("sheet1").Select

Range(firstpart2).Select

For i2 = 1 To rownum2
For j2 = 1 To colnum225
arr2(j2, i2) = (ActiveCell.Value)

ActiveCell.Offset(0, 1).Select

Next j2

ActiveCell.Offset(1, 0).Select
For j2 = 1 To colnum225

ActiveCell.Offset(0, -1).Select

Next j2

Next i2
For i2 = 1 To rownum2
For j2 = 1 To colnum225
'MsgBox (arr2(j2, i2))

Next j2

Next i2

'MsgBox (" number of columns in the 2d array " & UBound(arr1, 1))
'MsgBox (" number of rows in the 2d array " & UBound(arr1, 2))

'Now the real deal
ReDim arr3(colnum, rownum) As String
Dim resultarr() As String
ReDim resultarr(colnum, rownum) As String

For i2 = 1 To rownum2
For j2 = 1 To colnum225
arr3(j2, i2) = arr2(j2, i2)

Next j2

Next i2
For i = 1 To rownum
For j = 1 To colnum
'MsgBox (arr3(j, i))
Next j
Next i
Dim checkvals() As Integer
ReDim checkvals(colnum) As Integer
Dim count1 As Integer
count1 = 0

Dim checkint As Integer
checkint = 0
Dim checkint2 As Integer
checkint2 = 0
Dim k As Integer
Dim l As Integer

sheetname = InputBox("Please result sheet name")
test_sheet (sheetname)
For i = 1 To rownum
For l = 1 To rownum
For j = 1 To colnum

For k = 1 To colnum

If arr3(j, i) <> "" Then

'MsgBox ("arr3 value " & arr3(j, i) & " and arr1 value " & arr1(k, l) & " are being compaired")
If IsNumeric(arr3(j, i)) And IsNumeric(arr1(k, l)) Then

If (arr3(j, i)) = (arr1(k, l)) Then
'MsgBox ("arr3 value " & arr3(j, i) & " and arr1 value " & arr1(k, l) & " are matched numerically")
'MsgBox ("true")

checkint = checkint + 1

Else
End If

ElseIf (Not IsNumeric(arr3(j, i))) And (Not IsNumeric(arr1(k, l))) Then
If (arr3(j, i)) = (arr1(k, l)) Then
'MsgBox ("arr3 value " & arr3(j, i) & " and arr1 value " & arr1(k, l) & " are matched as string")
'MsgBox ("true")

checkint = checkint + 1
End If

ElseIf (InStr(arr3(j, i), "<") <> 0) Or (InStr(arr3(j, i), ">") <> 0) Then
If j = k Then

'MsgBox ("arr3 value " & arr3(j, i) & " and arr1 value " & arr1(k, l) & " are being compaired")
If CBool(Evaluate(Replace(Replace("arr1(k, l) arr3(j, i)", "arr1(k, l)", arr1(k, l)), "arr3(j, i)", arr3(j, i)))) = True Then
checkint2 = checkint2 + 1
'MsgBox ("the value of checkint2 " & checkint2)

'MsgBox ("true")

Else

End If

Else
End If

Else

End If
Else

End If

Next k
'MsgBox ("exiting k look for checkint " & checkint)
'MsgBox ("the value of checkint is " & checkint)

'checkint = 0

'MsgBox ("the value of checkint2 " & checkint2)

If checkint2 >= 1 Then
checkint = checkint + 1
End If
checkint2 = 0

Next j

For j = 1 To colnum
If arr3(j, i) <> "" Then
count1 = count1 + 1
Else
End If
Next j
If count1 = checkint And checkint <> 0 Then
result = 1
Else
End If

'MsgBox ("exiting j look for checkint " & checkint & " count1 is " & count1 & "for " & l)
'MsgBox ("exiting j look for " & l & " time")
count1 = 0
checkint = 0

'MsgBox ("the value of result is " & result)

If result <> 0 Then

Sheets(sheetname).Activate
Range(temppos).Select
For j = 1 To colnum
ActiveCell.Value = arr1(j, l)
ActiveCell.Offset(0, 1).Select

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

ActiveCell.Offset(0, -1).Select

Next j
temppos = ActiveCell.Address

End If
result = 0

Next l
Next i

'For i = 1 To rownum
'For j = 1 To colnum
'MsgBox (resultarr(j, i))
'Next j
'Next i
'MsgBox (firstpart)

Sheets("sheet1").Select
Range(firstpart).Select
Dim param As String
param = ActiveCell.Value

Call setupcells(sheetname, temppos, param, rownum)
Dim choice As Integer
Dim temparrfinal() As String
ReDim temparrfinal(colnum, rownum) As String
choice = InputBox("1 for same sheet 2 for the different sheet")
If choice = 1 Then
Sheets(sheetname).Activate
'MsgBox (temppos)

Range(temppos).Select
While ActiveCell.Value <> param

ActiveCell.Offset(-1, 0).Select

Wend
For i = 1 To rownum
For j = 1 To colnum
temparrfinal(j, i) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select

Next j

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

ActiveCell.Offset(0, -1).Select

Next j
Next i
test_sheet ("temp_data")

Sheets("sheet1").Select
Range(firstpart).Select

    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("temp_data").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
     Application.CutCopyMode = False

'For i = 1 To rownum
'For j = 1 To colnum
'MsgBox (temparrfinal(j, i))
'Next j
'Next i

Sheets("sheet1").Select
Range(firstpart).Select

param = ActiveCell.Value
'Application.ScreenUpdating = True
Call message(colnum, rownum, param, firstpart, sheetname, temppos)
'Application.Wait Now + TimeValue("00:00:20")

'Call samesheetcellsetup(colnum, rownum, param, sheetname, temppos)

End If

End Sub

Sub repaintsheet(firstpart As String)
Sheets("temp_data").Select
Range("a1").Select

    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("sheet1").Activate
    Range(firstpart).Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
   Application.CutCopyMode = False

End Sub
Sub test_check()
Dim k As Integer

Dim arr1() As String
Dim colnum1 As Integer
colnum1 = 3

ReDim arr1(colnum1) As String

Dim i As Integer
Dim j As Integer

For i = 1 To 3

arr1(i) = (InputBox("Please enter for arr1"))

Next i
Dim arr2() As String
Dim colnum As Integer
Dim rownum As Integer
colnum = 3
rownum = 4
Dim testval() As String

ReDim testval(colnum, rownum) As String

ReDim arr2(colnum, rownum) As String
For i = 1 To rownum

For j = 1 To colnum

arr2(j, i) = j

Next j

Next i

Sheets("sheet2").Select
Range("a1").Select
For i = 1 To rownum

For j = 1 To colnum

ActiveCell.Value = arr2(j, i)
ActiveCell.Offset(0, 1).Select

Next j
For j = 1 To colnum

ActiveCell.Offset(0, -1).Select

Next j
ActiveCell.Offset(1, 0).Select

Next i

For i = 1 To rownum

For j = 1 To colnum

'MsgBox (arr2(j, i))

Next j

Next i
Dim signal As Integer
signal = 0
For k = 1 To colnum1

For i = 1 To rownum

For j = 1 To colnum

MsgBox (arr1(k) & " " & arr2(j, i))
If arr1(k) = arr2(j, i) Then

testval(j, i) = 0
Else
testval(j, i) = 1

End If

Next j

Next i

Next k
For i = 1 To rownum

For j = 1 To colnum

'MsgBox (arr2(j, i))

MsgBox ("check val is " & testval(j, i))

Next j

Next i

End Sub

Sub anothertest()

Dim i As Integer
i = 5
For i = 1 To 5

If i = 3 Then

continue

End If

MsgBox (i)

Next i
End Sub

Sub test5()

Dim s As String
s = "sourav"
MsgBox (InStr(s, "o"))

End Sub

Sub setupcells(sheetname As String, temppos As String, param As String, rownum As Integer)
Sheets(sheetname).Activate
Dim pos1 As String
Dim pos2 As String

Dim i As Long
Range(temppos).Select

While ActiveCell.Value <> param

ActiveCell.Offset(-1, 0).Select

Wend

pos1 = ActiveCell.Address

Dim tempholder() As String
ReDim tempholder(rownum) As String

Dim count As Integer

For i = 1 To rownum
tempholder(i) = ActiveCell.Value
ActiveCell.Offset(1, 0).Select

Next i

For i = 1 To rownum

For j = i + 1 To rownum
If tempholder(i) = tempholder(j) Then

tempholder(j) = ""
End If

Next j

Next i
Range(pos1).Select
For i = 1 To rownum
ActiveCell.Value = tempholder(i)
ActiveCell.Offset(1, 0).Select

Next i

Range(pos1).Select
For i = 1 To rownum
If ActiveCell.Value = "" Then

ActiveCell.EntireRow.Delete
ActiveCell.Offset(1, 0).Select
End If
ActiveCell.Offset(1, 0).Select
Next i

End Sub

Sub calltestsheet()

Dim sheetname As String
sheetname = InputBox("Please result sheet name")
test_sheet (sheetname)

End Sub

Sub test_sheet(sheetname As String)

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

Worksheets.Add(After:=Worksheets(Worksheets.count)).name = sheetname

End Sub

Sub samesheetcellsetup(colnum As Integer, rownum As Integer, param As String, firstpart As String, sheetname As String, temppos As String)
Dim i As Long
Dim j As Long
Dim temparrfinal() As String
ReDim temparrfinal(colnum, rownum) As String
Sheets(sheetname).Activate
'MsgBox (param)
'MsgBox (temppos)

Range(temppos).Select
While ActiveCell.Value <> param

ActiveCell.Offset(-1, 0).Select

Wend
'MsgBox (ActiveCell.Address)
For i = 1 To rownum
For j = 1 To colnum
temparrfinal(j, i) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select

Next j

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

ActiveCell.Offset(0, -1).Select

Next j
Next i

Sheets("sheet1").Select
Range(firstpart).Select
For i = 1 To rownum
For j = 1 To colnum
ActiveCell.Value = temparrfinal(j, i)
ActiveCell.Offset(0, 1).Select

Next j

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

ActiveCell.Offset(0, -1).Select

Next j
Next i

End Sub

Sub samesheetdellcellsetup(colnum As Integer, rownum As Integer, firstpart As String, sheetname As String, temppos As String)
Dim i As Long
Dim j As Long

Sheets("sheet1").Select
Range(firstpart).Select
For i = 1 To rownum
For j = 1 To colnum
ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select

Next j

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

ActiveCell.Offset(0, -1).Select

Next j
Next i

End Sub

Sub col_insert()
'
' Macro3 Macro
'

Sheets("sheet1").Select
    Range("A1").Select
    Selection.EntireColumn.Insert
End Sub
Sub col_delete()

Sheets("sheet1").Select
    Range("A1").Select
    Selection.EntireColumn.Delete


End Sub

Wednesday, April 20, 2016

My stupid version of advanced filter macro,Sourav Bhattacharya,VBA Teacher

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim KeyCells As Range

    Set KeyCells = Range("F2:G2")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

     macro4


    End If

End Sub

Sub macro4()

database_clearfilter
clear_result

Workbooks("Macro_1.xlsm").Activate
    Sheets("DATABASE").Activate
ActiveSheet.Range("A2").Select

    Dim i As Long
    Dim count As Integer

    Dim str1 As String
    For i = 1 To 500000
    If ActiveCell.Value = "DOA(Month)" Then
    str1 = ActiveCell.Address
    Exit For
    Else
    ActiveCell.Offset(0, 1).Select
End If






    Next i
    MsgBox (str1)
   ActiveSheet.Range(str1).Select
    For i = 1 To 500000
    If ActiveCell.Value = "" Then

    Exit For
    Else
    str1 = ActiveCell.Address


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






    Next i


   MsgBox (str1)

    Dim str2 As String
    str2 = "A2:" & str1
    MsgBox (str2)
    Sheets("DATABASE").Activate

    Range(str2).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("Dlr Filter_1st Macro").Range("F1:G2"), Unique:=False

    Range("A2").Select

    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Dlr Filter_1st Macro").Select

    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
database_clearfilter

End Sub

Sub database_clearfilter()
Workbooks("Macro_1.xlsm").Activate
    Sheets("DATABASE").Activate

If ActiveSheet.AutoFilterMode Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
End If
End Sub

Sub clear_result()

Workbooks("Macro_1.xlsm").Activate
    Sheets("Dlr Filter_1st Macro").Activate
ActiveSheet.Range("A3").Select

    Dim i As Long
    Dim count As Integer

    Dim str1 As String
    For i = 1 To 500000
    If ActiveCell.Value = "DOA(Month)" Then
    str1 = ActiveCell.Address
    Exit For
    Else
    ActiveCell.Offset(0, 1).Select
End If






    Next i
    MsgBox (str1)
   ActiveSheet.Range(str1).Select
    For i = 1 To 500000
    If ActiveCell.Value = "" Then

    Exit For
    Else
    str1 = ActiveCell.Address


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






    Next i


   MsgBox (str1)

    Dim str2 As String
    str2 = "A3:" & str1
    MsgBox (str2)
Range(str2).Clear

End Sub