Moderator: Tech Team
dgz345 wrote:idk how xls works with getting information from the internet. but ill look into it when i have time. tho ill only look into it because im intressted. so if i lose intrest there will not be a finished product.
MrBenn wrote:dgz345 wrote:idk how xls works with getting information from the internet. but ill look into it when i have time. tho ill only look into it because im intressted. so if i lose intrest there will not be a finished product.
I've written some vba code that gets data from api into an xls document... but that's at work right now... If nobody else gets around to it, I might look at it over the weekend.
runewake2 wrote:This will indeed be harder than you want as the points won/lost are not given by the API at this time. You'll need to use the API to get the players in the game and then download each games log and find the points rewarded sections to get this working. Your looking at some very scary macros. I've never written an Office App before, maybe I should...
BGtheBrain wrote:Would it be possible to make a sheet formula where I could input a game # in column A, then column B would reflect Map Name, Column C would show player x points won/lost for each player?
I have about 150 games Im trying to compile the data for and this would be sweet.
Game | Points Totals | Player | Points |
14191088 | SuicidalSnowman scored -13 points in this game | SuicidalSnowman | -13 |
BGtheBrain scored 149 points in this game | BGtheBrain | 149 | |
Steve The Mighty scored -17 points in this game | Steve The Mighty | -17 | |
Vid_FISO scored -19 points in this game | Vid_FISO | -19 |
=LEFT(B2,FIND("scored",B2,1)-2)
=MID(B2,FIND("scored",B2,1)+7,FIND("points",B2,1)-1-FIND("scored",B2,1)-7)
Sub get_cc_gamedata()
' Assumption that Game number is in column A
' Assumption the column has a header
Set SrchRange = Columns(1).EntireColumn
Set FindCell = SrchRange.Find(What:="*", after:=SrchRange.Cells(1), searchorder:=xlByRows, searchdirection:=xlPrevious)
If Not FindCell Is Nothing Then
R = FindCell.Row
If R < 2 Then Exit Sub
End If
Cells(1, 2).Value = "Players"
Cells(1, 3).Value = "Type"
Cells(1, 4).Value = "Map"
Cells(1, 5).Value = "Player Name"
Cells(1, 6).Value = "Player Status"
Cells(1, 7).Value = "Points Gained/Lost"
Cells(1, 8).Value = "Kills"
Cells(1, 9).Value = "Elim Order"
i = 2
Do
'For i = 2 To R Step 1
GameNo = Cells(i, 1).Value
If Not GameNo = Empty Then
GameData = ccGameAPI(CStr(GameNo))
Cells(i, 2).Value = UBound(GameData)
Cells(i, 3).Value = GameData(0, 0)
Cells(i, 4).Value = GameData(0, 1)
For p = 1 To UBound(GameData)
Cells(i, 5).Value = GameData(p, 0)
Cells(i, 6).Value = GameData(p, 1)
Cells(i, 7).Value = GameData(p, 2)
Cells(i, 8).Value = CInt(GameData(p, 3))
Cells(i, 9).Value = GameData(p, 4)
If p < UBound(GameData) Then
Rows(i + 1).EntireRow.Insert
i = i + 1
R = R + 1
End If
Next p
End If
i = i + 1
'Next i
Loop While i <= R
Cells.EntireColumn.AutoFit
End Sub
Function ccGameAPI(GameNo As String)
'If this causes a "user defined type not defined" error then:
'Inside the Visual Basic Editor (can be accessed from the Macro menu:
' Go to Tools -> References, then Select Microsoft XML, v6.0 (or whatever your latest is).
Dim xmlDoc As MSXML2.DOMDocument
Dim xresult As MSXML2.IXMLDOMNode
Dim xentry As MSXML2.IXMLDOMNode
Dim xChild As MSXML2.IXMLDOMNode
ccAPIpath = "http://www.conquerclub.com/api.php?mode=gamelist&gn=" & GameNo _
& "&names=Y&events=Y"
Set xmlDoc = New MSXML2.DOMDocument
With xmlDoc
.async = False
.validateOnParse = False
.Load (ccAPIpath)
Set GameData = .FirstChild.childNodes(1).FirstChild
End With
p = GameData.selectSingleNode("players").childNodes.Length
Dim GamePlayers()
ReDim GamePlayers(0 To p, 0 To 4)
' (p, 0) = Player Name
' (p, 1) = Plater State (Won/Lost)
' (p, 2) = Points Gained/Lost
' (p, 3) = Eliminations made
' (p, 4) = Kill Order
'UBound(GamePlayers) '-- Number of Players
'GamePlayers(0, 0) = GameData.childNodes(6).Text
'game type (S)tandard, (C)Terminator, (A)ssassin, (D)oubles, (T)riples or (Q)uadruples
GamePlayers(0, 0) = GameData.selectSingleNode("game_type").Text
GamePlayers(0, 1) = GameData.selectSingleNode("map").Text
For p = 1 To UBound(GamePlayers) Step 1
With GameData.selectSingleNode("players").childNodes(p - 1)
'GameData.childNodes(18).childNodes(e - 1)
GamePlayers(p, 0) = .Text
GamePlayers(p, 1) = .Attributes(0).nodeValue
End With
Next p
ko = 1
For e = 1 To GameData.selectSingleNode("events").childNodes.Length
With GameData.selectSingleNode("events").childNodes(e - 1)
'GameData.childNodes(19).childNodes(e - 1)
If Right(.Text, 7) = " points" Then
l = InStr(.Text, " ")
p = CInt(Left(.Text, l))
GamePlayers(p, 2) = CInt(Replace(Replace(Replace( _
Mid(.Text, l, Len(.Text)), _
"loses", "-"), "gains", "+"), "points", ""))
ElseIf Right(.Text, 14) = " from the game" Then
l = InStr(.Text, " ")
p = CInt(Left(.Text, l))
GamePlayers(p, 3) = GamePlayers(p, 3) + 1
t = .Text
t = Mid(.Text, l, Len(.Text))
GamePlayers(CInt(Replace(Replace( _
Mid(.Text, l, Len(.Text)), _
"eliminated", ""), "from the game", "")) _
, 4) = ko
ko = ko + 1
End If
End With
Next e
ccGameAPI = GamePlayers
End Function
Sub get_cc_gamedata(R)
' Assumption that Game number is in column A
' Assumption the column has a header
Set SrchRange = Columns(1).EntireColumn
Set FindCell = SrchRange.Find(What:="*", after:=SrchRange.Cells(1), searchorder:=xlByRows, searchdirection:=xlPrevious)
If Not FindCell Is Nothing Then
R = FindCell.Row
If R < 2 Then Exit Sub
End If
Cells(1, 2).Value = "Players"
Cells(1, 3).Value = "Type"
Cells(1, 4).Value = "Map"
Cells(1, 5).Value = "Player Name"
Cells(1, 6).Value = "Player Status"
Cells(1, 7).Value = "Points Gained/Lost"
Cells(1, 8).Value = "Kills"
Cells(1, 9).Value = "Elim Order"
Cells(1, 11).Value = "Players"
Cells(1, 12).Value = "Totals"
i = 2
Do
'For i = 2 To R Step 1
GameNo = Cells(i, 1).Value
If Not GameNo = Empty Then
GameData = ccGameAPI(CStr(GameNo))
Cells(i, 2).Value = UBound(GameData)
Cells(i, 3).Value = GameData(0, 0)
Cells(i, 4).Value = GameData(0, 1)
For p = 1 To UBound(GameData)
Cells(i, 5).Value = GameData(p, 0)
Cells(i, 6).Value = GameData(p, 1)
Cells(i, 7).Value = GameData(p, 2)
Cells(i, 8).Value = CInt(GameData(p, 3))
Cells(i, 9).Value = GameData(p, 4)
If p < UBound(GameData) Then
Rows(i + 1).EntireRow.Insert
i = i + 1
R = R + 1
End If
Next p
End If
i = i + 1
'Next i
Loop While i <= R
Cells.EntireColumn.AutoFit
End Sub
Function ccGameAPI(GameNo As String)
'If this causes a "user defined type not defined" error then:
'Inside the Visual Basic Editor (can be accessed from the Macro menu:
' Go to Tools -> References, then Select Microsoft XML, v6.0 (or whatever your latest is).
Dim xmlDoc As MSXML2.DOMDocument
Dim xresult As MSXML2.IXMLDOMNode
Dim xentry As MSXML2.IXMLDOMNode
Dim xChild As MSXML2.IXMLDOMNode
ccAPIpath = "http://www.conquerclub.com/api.php?mode=gamelist&gn=" & GameNo _
& "&names=Y&events=Y"
Set xmlDoc = New MSXML2.DOMDocument
With xmlDoc
.async = False
.validateOnParse = False
.Load (ccAPIpath)
Set GameData = .FirstChild.ChildNodes(1).FirstChild
End With
p = GameData.SelectSingleNode("players").ChildNodes.Length
Dim GamePlayers()
ReDim GamePlayers(0 To p, 0 To 4)
' (p, 0) = Player Name
' (p, 1) = Plater State (Won/Lost)
' (p, 2) = Points Gained/Lost
' (p, 3) = Eliminations made
' (p, 4) = Kill Order
'UBound(GamePlayers) '-- Number of Players
'GamePlayers(0, 0) = GameData.childNodes(6).Text
'game type (S)tandard, (C)Terminator, (A)ssassin, (D)oubles, (T)riples or (Q)uadruples
GamePlayers(0, 0) = GameData.SelectSingleNode("game_type").Text
GamePlayers(0, 1) = GameData.SelectSingleNode("map").Text
For p = 1 To UBound(GamePlayers) Step 1
With GameData.SelectSingleNode("players").ChildNodes(p - 1)
'GameData.childNodes(18).childNodes(e - 1)
GamePlayers(p, 0) = .Text
GamePlayers(p, 1) = .Attributes(0).NodeValue
End With
Next p
ko = 1
For e = 1 To GameData.SelectSingleNode("events").ChildNodes.Length
With GameData.SelectSingleNode("events").ChildNodes(e - 1)
'GameData.childNodes(19).childNodes(e - 1)
If Right(.Text, 7) = " points" Then
l = InStr(.Text, " ")
p = CInt(Left(.Text, l))
GamePlayers(p, 2) = CInt(Replace(Replace(Replace( _
Mid(.Text, l, Len(.Text)), _
"loses", "-"), "gains", "+"), "points", ""))
ElseIf Right(.Text, 14) = " from the game" Then
l = InStr(.Text, " ")
p = CInt(Left(.Text, l))
GamePlayers(p, 3) = GamePlayers(p, 3) + 1
t = .Text
t = Mid(.Text, l, Len(.Text))
GamePlayers(CInt(Replace(Replace( _
Mid(.Text, l, Len(.Text)), _
"eliminated", ""), "from the game", "")) _
, 4) = ko
ko = ko + 1
End If
End With
Next e
ccGameAPI = GamePlayers
End Function
Sub SumScores()
'
' Game Nos titles in cell(1A)
' List of game numbers in column A from cell(2A)
'
Call get_cc_gamedata(R)
Range(Cells(2, 5), Cells(R, 5)).Select
Selection.Copy
Cells(2, 11).Select
ActiveSheet.Paste
Range(Cells(2, 7), Cells(R, 7)).Select
Selection.Copy
Cells(2, 12).Select
ActiveSheet.Paste
Range(Cells(2, 11), Cells(R, 12)).Select
Selection.Sort Key1:=Range(Cells(2, 11), Cells(R, 12)), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
j = 1
While j = 1
j = 0
For i = 2 To R - 1
A = Cells(i, 11).Value
B = Cells(i + 1, 11).Value
If A = B And A <> "" Then
Cells(i, 12).Value = Cells(i, 12).Value + Cells(i + 1, 12).Value
Cells(i + 1, 11).Value = ""
Cells(i + 1, 12).Value = ""
j = 1
End If
Next i
Range(Cells(2, 11), Cells(R, 12)).Select
Selection.Sort Key1:=Range(Cells(2, 11), Cells(R, 12)), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Wend
Range(Cells(2, 11), Cells(R, 12)).Select
Selection.Sort Key1:=Range(Cells(2, 12), Cells(R, 12)), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Stop
End Sub
Sub get_cc_gamedata(R)
' Assumption that Game number is in column A
' Assumption the column has a header
Set SrchRange = Columns(1).EntireColumn
Set FindCell = SrchRange.Find(What:="*", after:=SrchRange.Cells(1), searchorder:=xlByRows, searchdirection:=xlPrevious)
If Not FindCell Is Nothing Then
R = FindCell.Row
If R < 2 Then Exit Sub
End If
Cells(1, 1).Value = "Game Nos"
Cells(1, 2).Value = "Players"
Cells(1, 3).Value = "Type"
Cells(1, 4).Value = "Map"
Cells(1, 5).Value = "Player Name"
Cells(1, 6).Value = "Player Status"
Cells(1, 7).Value = "Points Gained/Lost"
Cells(1, 8).Value = "Kills"
Cells(1, 9).Value = "Elim Order"
Cells(1, 10).Value = "Round"
Cells(1, 12).Value = "Players"
Cells(1, 13).Value = "Totals"
i = 2
Do
'For i = 2 To R Step 1
GameNo = Cells(i, 1).Value
If Not GameNo = Empty Then
GameData = ccGameAPI(CStr(GameNo))
Cells(i, 2).Value = UBound(GameData)
Cells(i, 3).Value = GameData(0, 0)
Cells(i, 4).Value = GameData(0, 1)
For p = 1 To UBound(GameData)
Cells(i, 5).Value = GameData(p, 0)
Cells(i, 6).Value = GameData(p, 1)
Cells(i, 7).Value = GameData(p, 2)
Cells(i, 8).Value = CInt(GameData(p, 3))
Cells(i, 9).Value = GameData(p, 4)
Cells(i, 10).Value = GameData(0, 5)
If p < UBound(GameData) Then
Rows(i + 1).EntireRow.Insert
i = i + 1
R = R + 1
End If
Next p
End If
i = i + 1
'Next i
Loop While i <= R
Cells.EntireColumn.AutoFit
End Sub
Function ccGameAPI(GameNo As String)
'If this causes a "user defined type not defined" error then:
'Inside the Visual Basic Editor (can be accessed from the Macro menu:
' Go to Tools -> References, then Select Microsoft XML, v6.0 (or whatever your latest is).
Dim xmlDoc As MSXML2.DOMDocument
Dim xresult As MSXML2.IXMLDOMNode
Dim xentry As MSXML2.IXMLDOMNode
Dim xChild As MSXML2.IXMLDOMNode
ccAPIpath = "http://www.conquerclub.com/api.php?mode=gamelist&gn=" & GameNo _
& "&names=Y&events=Y"
Set xmlDoc = New MSXML2.DOMDocument
With xmlDoc
.async = False
.validateOnParse = False
.Load (ccAPIpath)
Set GameData = .FirstChild.ChildNodes(1).FirstChild
End With
p = GameData.SelectSingleNode("players").ChildNodes.Length
Dim GamePlayers()
ReDim GamePlayers(0 To p, 0 To 5)
' (p, 0) = Player Name
' (p, 1) = Player State (Won/Lost)
' (p, 2) = Points Gained/Lost
' (p, 3) = Eliminations made
' (p, 4) = Kill Order
' (p, 5) = Round
'UBound(GamePlayers) '-- Number of Players
'GamePlayers(0, 0) = GameData.childNodes(6).Text
'game type (S)tandard, (C)Terminator, (A)ssassin, (D)oubles, (T)riples or (Q)uadruples
GamePlayers(0, 0) = GameData.SelectSingleNode("game_type").Text
GamePlayers(0, 1) = GameData.SelectSingleNode("map").Text
GamePlayers(0, 5) = GameData.SelectSingleNode("round").Text
For p = 1 To UBound(GamePlayers) Step 1
GamePlayers(p, 2) = 0
With GameData.SelectSingleNode("players").ChildNodes(p - 1)
'GameData.childNodes(18).childNodes(e - 1)
GamePlayers(p, 0) = .Text
GamePlayers(p, 1) = .Attributes(0).NodeValue
End With
Next p
ko = 1
For e = 1 To GameData.SelectSingleNode("events").ChildNodes.Length
With GameData.SelectSingleNode("events").ChildNodes(e - 1)
'GameData.childNodes(19).childNodes(e - 1)
If Right(.Text, 7) = " points" Then
l = InStr(.Text, " ")
p = CInt(Left(.Text, l))
GamePlayers(p, 2) = GamePlayers(p, 2) + CInt(Replace(Replace(Replace( _
Mid(.Text, l, Len(.Text)), _
"loses", "-"), "gains", "+"), "points", ""))
ElseIf Right(.Text, 14) = " from the game" Then
l = InStr(.Text, " ")
p = CInt(Left(.Text, l))
GamePlayers(p, 3) = GamePlayers(p, 3) + 1
t = .Text
t = Mid(.Text, l, Len(.Text))
GamePlayers(CInt(Replace(Replace( _
Mid(.Text, l, Len(.Text)), _
"eliminated", ""), "from the game", "")) _
, 4) = ko
ko = ko + 1
End If
End With
Next e
ccGameAPI = GamePlayers
End Function
Sub SumScores()
'
' Game Nos titles in cell(1A)
' List of game numbers in column A from cell(2A)
'
Call get_cc_gamedata(R)
Range(Cells(2, 5), Cells(R, 5)).Select
Selection.Copy
Cells(2, 12).Select
ActiveSheet.Paste
Range(Cells(2, 7), Cells(R, 7)).Select
Selection.Copy
Cells(2, 13).Select
ActiveSheet.Paste
Range(Cells(2, 12), Cells(R, 13)).Select
Selection.Sort Key1:=Range(Cells(2, 12), Cells(R, 13)), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
j = 1
While j = 1
j = 0
For i = 2 To R - 1
A = Cells(i, 12).Value
B = Cells(i + 1, 12).Value
If A = B And A <> "" Then
Cells(i, 13).Value = Cells(i, 13).Value + Cells(i + 1, 13).Value
Cells(i + 1, 12).Value = ""
Cells(i + 1, 13).Value = ""
j = 1
End If
Next i
Range(Cells(2, 12), Cells(R, 13)).Select
Selection.Sort Key1:=Range(Cells(2, 12), Cells(R, 13)), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Wend
Range(Cells(2, 12), Cells(R, 13)).Select
Selection.Sort Key1:=Range(Cells(2, 13), Cells(R, 13)), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Sub get_cc_gamedata(R)
' Assumption that Game number is in column A
' Assumption the column has a header
Set SrchRange = Columns(1).EntireColumn
Set FindCell = SrchRange.Find(What:="*", after:=SrchRange.Cells(1), searchorder:=xlByRows, searchdirection:=xlPrevious)
If Not FindCell Is Nothing Then
R = FindCell.Row
If R < 2 Then Exit Sub
End If
Cells(1, 1).Value = "Game Nos"
Cells(1, 2).Value = "Players"
Cells(1, 3).Value = "Type"
Cells(1, 4).Value = "Map"
Cells(1, 5).Value = "Player Name"
Cells(1, 6).Value = "Player Status"
Cells(1, 7).Value = "Points Gained/Lost"
Cells(1, 8).Value = "Kills"
Cells(1, 9).Value = "Elim Order"
Cells(1, 10).Value = "Round"
Cells(1, 12).Value = "Players"
Cells(1, 13).Value = "Totals"
i = 2
Do
'For i = 2 To R Step 1
GameNo = Cells(i, 1).Value
If Not GameNo = Empty Then
GameData = ccGameAPI(CStr(GameNo))
Cells(i, 2).Value = UBound(GameData)
Cells(i, 3).Value = GameData(0, 0)
Cells(i, 4).Value = GameData(0, 1)
Range(Cells(i, 1), Cells(i, 10)).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
For p = 1 To UBound(GameData)
Cells(i, 5).Value = GameData(p, 0)
Cells(i, 6).Value = GameData(p, 1)
Cells(i, 7).Value = GameData(p, 2)
Cells(i, 8).Value = CInt(GameData(p, 3))
Cells(i, 9).Value = GameData(p, 4)
Cells(i, 10).Value = GameData(0, 5)
If p < UBound(GameData) Then
Rows(i + 1).EntireRow.Insert
i = i + 1
R = R + 1
End If
Next p
End If
i = i + 1
'Next i
Loop While i <= R
Cells.EntireColumn.AutoFit
End Sub
Function ccGameAPI(GameNo As String)
'If this causes a "user defined type not defined" error then:
'Inside the Visual Basic Editor (can be accessed from the Macro menu:
' Go to Tools -> References, then Select Microsoft XML, v6.0 (or whatever your latest is).
Dim xmlDoc As MSXML2.DOMDocument
Dim xresult As MSXML2.IXMLDOMNode
Dim xentry As MSXML2.IXMLDOMNode
Dim xChild As MSXML2.IXMLDOMNode
ccAPIpath = "http://www.conquerclub.com/api.php?mode=gamelist&gn=" & GameNo _
& "&names=Y&events=Y"
Set xmlDoc = New MSXML2.DOMDocument
With xmlDoc
.async = False
.validateOnParse = False
.Load (ccAPIpath)
Set GameData = .FirstChild.ChildNodes(1).FirstChild
End With
p = GameData.SelectSingleNode("players").ChildNodes.Length
Dim GamePlayers()
ReDim GamePlayers(0 To p, 0 To 5)
' (p, 0) = Player Name
' (p, 1) = Player State (Won/Lost)
' (p, 2) = Points Gained/Lost
' (p, 3) = Eliminations made
' (p, 4) = Kill Order
' (p, 5) = Round
'UBound(GamePlayers) '-- Number of Players
'GamePlayers(0, 0) = GameData.childNodes(6).Text
'game type (S)tandard, (C)Terminator, (A)ssassin, (D)oubles, (T)riples or (Q)uadruples
GamePlayers(0, 0) = GameData.SelectSingleNode("game_type").Text
GamePlayers(0, 1) = GameData.SelectSingleNode("map").Text
GamePlayers(0, 5) = GameData.SelectSingleNode("round").Text
For p = 1 To UBound(GamePlayers) Step 1
GamePlayers(p, 2) = 0
With GameData.SelectSingleNode("players").ChildNodes(p - 1)
'GameData.childNodes(18).childNodes(e - 1)
GamePlayers(p, 0) = .Text
GamePlayers(p, 1) = .Attributes(0).NodeValue
End With
Next p
ko = 1
For e = 1 To GameData.SelectSingleNode("events").ChildNodes.Length
With GameData.SelectSingleNode("events").ChildNodes(e - 1)
'GameData.childNodes(19).childNodes(e - 1)
If Right(.Text, 7) = " points" Then
l = InStr(.Text, " ")
p = CInt(Left(.Text, l))
GamePlayers(p, 2) = GamePlayers(p, 2) + CInt(Replace(Replace(Replace( _
Mid(.Text, l, Len(.Text)), _
"loses", "-"), "gains", "+"), "points", ""))
ElseIf Right(.Text, 14) = " from the game" Then
l = InStr(.Text, " ")
p = CInt(Left(.Text, l))
GamePlayers(p, 3) = GamePlayers(p, 3) + 1
t = .Text
t = Mid(.Text, l, Len(.Text))
GamePlayers(CInt(Replace(Replace( _
Mid(.Text, l, Len(.Text)), _
"eliminated", ""), "from the game", "")) _
, 4) = ko
ko = ko + 1
End If
End With
Next e
ccGameAPI = GamePlayers
End Function
Sub SumScores()
'
' Game Nos titles in cell(1A)
' List of game numbers in column A from cell(2A)
'
Call get_cc_gamedata(R)
Range(Cells(2, 5), Cells(R, 5)).Select
Selection.Copy
Cells(2, 12).Select
ActiveSheet.Paste
Range(Cells(2, 7), Cells(R, 7)).Select
Selection.Copy
Cells(2, 13).Select
ActiveSheet.Paste
Range(Cells(2, 12), Cells(R, 13)).Select
Selection.Sort Key1:=Range(Cells(2, 12), Cells(R, 13)), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
j = 1
While j = 1
j = 0
For i = 2 To R - 1
A = Cells(i, 12).Value
B = Cells(i + 1, 12).Value
If A = B And A <> "" Then
Cells(i, 13).Value = Cells(i, 13).Value + Cells(i + 1, 13).Value
Cells(i + 1, 12).Value = ""
Cells(i + 1, 13).Value = ""
j = 1
End If
Next i
Range(Cells(2, 12), Cells(R, 13)).Select
Selection.Sort Key1:=Range(Cells(2, 12), Cells(R, 13)), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Wend
Range(Cells(2, 12), Cells(R, 13)).Select
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Sort Key1:=Range(Cells(2, 13), Cells(R, 13)), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Users browsing this forum: No registered users