Download Delhi ER2015

Sub DelhiER2015Downloadcode()
    
' VBA Macro Code to download Delhi Assembly Election Result 2015

'Sheets.Add before:=Sheet1
Sheets("Sheet1").Activate
ActiveSheet.Name = "List"
Range("A1") = "AC No"
Range("B1") = "Link"
Range("C1") = "Name"

Dim k As Integer

For k = 1 To 70

Cells((k + 1), 1) = "http://eciresults.nic.in/ConstituencywiseU05" & k & ".htm?ac=" & k
Cells((k + 1), 2) = k
Cells((k + 1), 3) = "ConstituencywiseU05" & k & ".htm?ac=" & k

Next k

' Code to add a Sheet name ER where we download election result

'Sheets.Add before:=Sheet1
Sheets("Sheet3").Activate
ActiveSheet.Name = "Winning Candidate"
  
    Cells(1, 1) = "AC No"
    Cells(1, 2) = "AC Name"
    Cells(1, 3) = "Win Candidate"
    Cells(1, 4) = "Win Party"
    Cells(1, 5) = "Win Votes"
    Cells(1, 6) = "Runnerup Candidate"
    Cells(1, 7) = "Runnerup Party"
    Cells(1, 8) = "Runnerup Votes"
    Cells(1, 9) = "Margin"
    Cells(1, 10) = "Category" ' 0-10k,10k-20k,20k-50k,50k+
  
Sheets("Sheet2").Activate
ActiveSheet.Name = "ER"

    Cells(1, 1) = "AC No"
    Cells(1, 2) = "AC Name"
    Cells(1, 3) = "Result"
    Cells(1, 4) = "Candidate"
    Cells(1, 5) = "Party"
    Cells(1, 6) = "Votes"
    Cells(1, 7) = "Position"
  

Sheets("Er").Activate
  
rng1 = 2
  
    For i = 1 To 70
    lnk = "URL;" & Sheets("list").Cells((i + 1), 1)
    n = Sheets("list").Cells((i + 1), 3)
  
Sheets("Er").Cells(rng1, 1) = i

  
    With ActiveSheet.QueryTables.Add(Connection:= _
        lnk, Destination:= _
        Cells(rng1, 4))
        .Name = n
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "10"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
 Cells(rng1, 2) = Cells(rng1, 4)
 Cells(rng1, 3) = Cells(rng1 + 1, 4)
'
'ActiveCell.SpecialCells(xlLastCell).Select
Cells(rng1, 4).Select
Selection.End(xlDown).Select

Lastcell = ActiveCell.Row
    Rng = "A" & Lastcell & ":B" & Lastcell & ":C" & Lastcell
    Range(Rng).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
  
    rng1 = Lastcell + 1
  
Next i


  
' ' Macro Program to Countif Function in Column B and result in G

    Sheets("ER").Activate
    ActiveSheet.Cells(2, 7).Select
    ActiveCell.Formula = "=COUNTIF(B2:$B$2,B2)"
    Range("B2").Select
    Selection.End(xlDown).Select
    Lastcell = ActiveCell.Row
    Rng = "G" & Lastcell
    Range(Rng).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    Selection.End(xlUp).Select
  

  
 ' Program to filter in Column G, select 1, 2 and 3 and then delete it
  
    Sheets("ER").Cells(2, 7).Select
    Selection.AutoFilter
    ActiveSheet.Cells(2, 7).Select
    ActiveSheet.Range("$A$1:$G$954").AutoFilter Field:=7, Criteria1:=Array("1", _
        "2", "3"), Operator:=xlFilterValues
    Cells(2, 7).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
  

  
    Sheets("Winning Candidate").Activate
    Range("A:B").EntireColumn.Insert
    Cells(1, 1) = "Merge1"
    Cells(1, 2) = "Merge2"
  
    Dim L As Integer
    For L = 1 To 70
    Cells((L + 1), 1) = L & "@1"
    Cells((L + 1), 2) = L & "@2"
    Cells((L + 1), 3) = L
    Next L
  
    Range("A:B").EntireColumn.Hidden = True
  
    Sheets("ER").Activate
    Range("A1").EntireColumn.Insert
    Cells(1, 1) = "Merge"
  
    Cellcount = Application.WorksheetFunction.CountA(Range("B:B"))
    For b = 2 To Cellcount
    Range("A" & b).Value = Range("B" & b) & "@" & Range("H" & b)
    Next b

    Range("A1").EntireColumn.Hidden = True
  
  
    Sheets("Winning Candidate").Activate
  
    Cells(2, 4).Select
    ActiveCell.Formula = "=VLOOKUP($C2,ER!$B$1:$G$2000,2,0)"
    Cells(2, 5).Select
    ActiveCell.Formula = "=VLOOKUP($A2,ER!$A$1:$G$2000,5,0)"
    Cells(2, 6).Select
    ActiveCell.Formula = "=VLOOKUP($A2,ER!$A$1:$G$2000,6,0)"
    Cells(2, 7).Select
    ActiveCell.Formula = "=VLOOKUP($A2,ER!$A$1:$G$2000,7,0)"
    Cells(2, 8).Select
    ActiveCell.Formula = "=VLOOKUP($B2,ER!$A$1:$G$2000,5,0)"
    Cells(2, 9).Select
    ActiveCell.Formula = "=VLOOKUP($B2,ER!$A$1:$G$2000,6,0)"
    Cells(2, 10).Select
    ActiveCell.Formula = "=VLOOKUP($B2,ER!$A$1:$G$2000,7,0)"
    Cells(2, 11).Select
    ActiveCell.Formula = "=G2-J2"
    'Cells(2, 12).Select
    'ActiveCell.Formula = "=IF(K2<10000,'0-10k',IF(K2<20000,'10k-20k',IF(K2<30000,'20k-30k',IF(K2<50000,'30K-50K','50k+'))))"
    Cells(2, 3).Select
    Selection.End(xlDown).Select
    Lastcell = ActiveCell.Row
    Rng = "D" & Lastcell & ":E" & Lastcell & ":F" & Lastcell & ":G" & Lastcell & ":H" & Lastcell & ":I" & Lastcell & ":J" & Lastcell & ":K" & Lastcell
    Range(Rng).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    Selection.End(xlUp).Select
  

Dim Cellcount1 As Integer

Cellcount1 = Application.WorksheetFunction.CountA(Range("A:A"))
For a = 2 To Cellcount1

Select Case Sheets("Winning Candidate").Cells(a, 11).Value
Case Is < 10000
Sheets("Winning Candidate").Cells(a, 12).Value = "0-10k"
Case Is < 20000
Sheets("Winning Candidate").Cells(a, 12).Value = "10k-20k"
Case Is < 30000
Sheets("Winning Candidate").Cells(a, 12).Value = "20k-30k"
Case Is < 50000
Sheets("Winning Candidate").Cells(a, 12).Value = "30k-50k"
Case Else
Sheets("Winning Candidate").Cells(a, 12).Value = "50k+"

End Select

Next a


Sheets("ER").Activate

    Range("A1").EntireRow.Insert
    Range("B1") = "Delhi Election Result 2015"
    Range("B1:H1").MergeCells = True
    Range("B1:H1").HorizontalAlignment = xlCenter
    Range("B1:H1").Interior.Color = vbBlue
    Range("B1:H1").Font.Color = vbWhite
    Range("B1:H1").Font.Size = 12
    Range("B1:H1").Font.Name = "Times"
    Range("B1:H1").Font.FontStyle = "Bold"

With Range("B2:H2")
.Interior.Color = vbBlue
.Font.Color = vbWhite
.Font.Size = 11
.Font.Name = "Times"
.Font.FontStyle = "Bold"
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous

End With

Sheets("Winning Candidate").Activate

    Range("A1").EntireRow.Insert
    Range("C1") = "Delhi Election Result 2015 Winning Candidate"
    Range("C1:L1").MergeCells = True
    Range("C1:L1").HorizontalAlignment = xlCenter
    Range("C1:L1").Interior.Color = vbGreen
    Range("C1:L1").Font.Color = vbWhite
    Range("C1:L1").Font.Size = 12
    Range("C1:L1").Font.Name = "Times"
    Range("C1:L1").Font.FontStyle = "Bold"


With Range("C2:L2")
.Interior.Color = vbGreen
.Font.Color = vbWhite
.Font.Size = 11
.Font.Name = "Times"
.Font.FontStyle = "Bold"
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlLeft
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous

End With

End Sub

Comments

Post a Comment

Popular posts from this blog

TDS Calculation System

Image
TDS Calculation System Calculation of how much TDS should deduct from salary will become headache for every employee who will come in the criteria of Tax. In the month of Feb and March employee loosing patient and spent most of the time in internet and communicate with other employee and accountant for better solution to save tax but they do not get appropriate solution. I have designed a nice TDS Calculation System to calculator which will give right and valued information from which the get the scenario of interest and monthly TDS. Download File
Read more

VBA - Additional Controls Dialog Box "MISSING"

VBA - Additional Controls Dialog Box "MISSING" Additional Controls Dialog Box "MISSING" solution, let's do this. 1-click on start menu( in the left on your desk top ) 2-drage a shortcut of Microsoft Excel in your desktop 3-Right click on it and choose Properties then click on compatibility Tab 4-set check on run this program in compatibility mode for 5-Apply then OK Now open Microsoft Excel or (any ms Application like Word, ppt etc), You can see everything is OK and additional Control box is working well This problem usually happen when we change or config our Microsoft to new version( 2003 to 2010 ,.....)
Read more

Loan EMI Calculator Dashboard

Image
Loan EMI Calculator Dashboard Generally the Loan EMI calculation is a headache for every customer when  demanding a sum of money from any bank. The customers search in the internet for better solution but they do not get appropriate solution. We have designed a strong EMI loan calculator which will give right and valued information from which the customers get the scenario of interest and monthly EMI. For example, if any customer is taking 10 Lakh loan at the rate of 10% for the period of 15 years, he/she has to pay Rs 10,746 every month to the bank and if a customer is taking 5 Lakh loan at the rate of 10%, he/she has to pay Rs 5373 every month to the respective institution from where he/she has taken the loan. For Rs 7,50000, the customer has to pay Rs 8059 to the bank at the rate of 10% for the period of 15 years. For the loan of 10 Lakh, the customer has to pay 9,34289 as interest which will build up to 19,34,289 as total in 15 years whereas for the ...
Read more