Auto-retrieve and manage data from another spreadsheet

Hi

I use Excel 2002.

Spreadsheet 1 : Data source
Column One : 1st Basketball Team
Rockets
Kings

Column Two : 2nd Basketball Team
Orlando Magic
Bulls

Column Three : Score
97:98
87:79

They means (1st row) Rockets vs Orlando Magic (97:98), (2nd row) Kings vs Bulls (87:79)

How can I create the following spreadsheets using VBA?

---------------------------------------------------------------------
Spreadsheet 2 : Auto-retrieve data from Spreadsheet 1

Get basketball team data from column one and column two of spreadsheet 1, put them into one column in spreadsheet 2.

Column one (Sorted by alphabetic order and non-duplicated)
Bulls
Kings
Rockets
Orlando Magic

----------------------------------------------------------------------
Spreadsheet 3 : Auto-retrieve data from spreadsheet 1

Get score data from column three of spreadsheet 1

Split the data 97:98 into 97 and 98 of spreadsheet 1, put them into 2 columns of spreadsheet 2

Column one
97
87

Column two
98
79

-----------------------------------------------------------------------
Spreadsheet 4 : Auto-create a table according to the number of teams. indicate a color of cell according to the score result.

For example, there are 4 teams, the total numbers of round is 2.

Rockets vs Orlando Magic 97:98 round #1
Kings vs Bulls 87:79 round #1

Rockets vs Bulls 90:90 round #2
Kings vs Orlando Magic 91:89 round #2

Column 1 Column 2
Team name Round #1
Rockets Cell changes to Blue color if Rockets lose (97:98)
Orlando Magic Cell changes to Green color if OM won (97:98)
Kings Cell changes to Green color if Kings won (87:79)
Bulls Cell changes to Blue color if Bulls loss (87:79)

Column 1 Column 3
Team name Round #2
Rockets Cell changes to White color if Rockets equals (90:90)
Bulls Cell changes to White color if Bulls equals (90:90)
Kings Cell changes to Green color if Kings won (91:89)
Orlando Magic Cell changes to Green color if OM won (91:89)

Thanks for advice

Hi

1) I can understand the requirement to have a unique list of team names sorted alphabetically, but cannot understand why you would want to have a sheet with the 2 columns of numbers.
2) What is the difference between reworking sheet1 and creating a new sheet (sheet4). You can use text to columns to separate the results from column C in sheet1, into columns C and D. You could then color the cells based on the results.


rylo

Hi Rylo

1) Because I want to show the result in sheet 2 or 3:

Column 1 2 3 4
Rockets Orlando Magic 97 98
Kings Bulls 87 79

There is a ':' in the source data score column. I do not know how to split it and put them in a column.

2) That's what did I want to do in sheet 4 that you mentioned. There are 3 features:
(i) rework source data sheet 1 to make score into 2 columns.
(ii) comparing the score and identify the cell colours (win, loss, equal)
(iii) sheet 4 can update sheet 1 data automatically when open the excel program.

However, how can I do it? is there any example?

Thanks for your kind help.

Tommy

Tommy

Assumes that you have the 4 sheets in your file, with the data in sheet1 starting in A1

Sub aaa()
  Sheets("Sheet4").Cells.ClearContents
  Sheets("sheet4").Range("A:C").Value = Sheets("Sheet1").Range("A:C").Value
  With Sheets("sheet4")
    .Range("C1:C" & .Cells(Rows.Count, 3).End(xlUp).Row).TextToColumns Destination:=.Range("C1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    .Range("A:B").Interior.ColorIndex = xlNone
    For Each ce In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
      If ce.Offset(0, 2) > ce.Offset(0, 3) Then
        ce.Interior.ColorIndex = 4
        ce.Offset(0, 1).Interior.ColorIndex = 5
      ElseIf ce.Offset(0, 2) < ce.Offset(0, 3) Then
        ce.Interior.ColorIndex = 5
        ce.Offset(0, 1).Interior.ColorIndex = 4
      End If
    Next ce
  End With
  
  
  Sheets("Sheet3").Range("A:B").Value = Sheets("Sheet4").Range("C:D").Value
  
  Dim nodupes As New Collection
  With Sheets("Sheet1")
    For Each ce In .Range("A1:B" & .Cells(Rows.Count, 2).End(xlUp).Row)
      On Error Resume Next
      nodupes.Add Item:=ce.Value, key:=ce.Value
      On Error GoTo 0
    Next ce
  End With
  
  With Sheets("Sheet2")
    .Cells.ClearContents
    For i = 1 To nodupes.Count
      .Cells(i, "A").Value = nodupes(i)
    Next i
    .Range(.Range("A1"), .Range("A1").End(xlDown)).Sort key1:=.Range("A1"), Order1:=xlAscending, header:=xlNo
  End With
  
End Sub

rylo