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
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
