Arrays and Looping to fill them

[Tyron]

Hey Guys,

I was wondering if you might be able to help me. I have been all over the web pulling my hair out on this one.

It seems I can't find an informative answer on this. They all just seem to list code that does the job, but doesn't explain how it works.

Goal:
Grab data from sheet 1 that is listed horizontally and paste that information in sheet 2 vertically.

FROM: (SHEET 1)

	A	B	C	D	E	F	G
1	WEEK	TEAM1	TEAM2	TEAM3	TEAM4	TEAM5	TEAM6
2	1	40	50	60		80	90

<tbody>
</tbody>

TO: (SHEET 2)

	A	B	C
1	WEEK	TEAM	SCORE
2	1	TEAM1	40
3		TEAM2	50
4		TEAM3	60
5		TEAM5	80
6		TEAM6	90
7
8
9

<tbody>
</tbody>

If you notice above it omitted Team4 completely since there was no score for that week for that team.

I am aware that I have to have a Multidimensional array and use a loop to gather both the heading data (Team1-6) and the score data.
Here is my code so far:

Option Explicit

Sub FormatScores()
Dim TeamCount as Integer
Dim TeamScore as Integer

Dim VarTeamScore(6,6) As Variant

For TeamCount 0 to 6
  VarTeamScore(TeamCount) = Range(cells(1, TeamCount).value
  VarTeamScore(ScoreCount) = Range(cells(1, ScoreCount).Value
  TeamCount = TeamCount + 1
  ScoreCount = ScoreCount + 1
Next

End Sub

Any help would be great as the web has turned out to be very vague in explaining Arrays and using Loops with them.

later

Ty

 

[hiker95]

Tyron,

You have a lot of good questions.

I will address your questions by putting comments in the macro code, after, we find a solution that works for your actual raw data worksheet, and, the actual resulting worksheet.

It is always best to display your actual raw data worksheet(s) (and, their actual worksheet names), and, the results that you are looking for. This way we can usually find a solution on the first go.

My screenshots are based on your original screenshots in your reply #1.


In order to continue I will need the following:

1. A screenshot like you used in your reply #1 of SHEET 1 with its actual worksheet name, and, with more than 1 week of raw data, lets say 5 weeks.

2. A screenshot like you used in your reply #1 of SHEET 2 with its actual worksheet name, and, with more than 1 week ofresults, lets say 5 weeks.



If you are looking for good information on arrays, you want to see if anything in my most up to data list will help you:

Training / Books / Sites as of 8/30/2014

http://www.mrexcel.com/forum/excel-...anging-columns-rows-advanced.html#post3925232

 

[Tyron]

Hey hiker95,

Here are some images of the 2 worksheets. If a question should arise they are both in the same workbook.

Well, I would have liked to insert two pictures from my MSPaint, but for some reason I can't figure it out. So I will just use the Table function in here.

Before I do so I will say that I have changed my tab names. The first sheet is called "TeamData" and the second sheet is called "Scores"

As I said in the previous post, the macro works. I have even created 6 weeks of data so that I could try an empty a different positon for each week. It appears there is only a problem if team one does not have a score.

	A	B	C	D	E	F
1	Week	Team1	Team2	Team3	Team4	Team5
2	1	50	60		80	90
3	2	36	10	100	86	52
4	3	50	18	125		68
5	4	22		118	5	26
6	5		22	59	36	180
7	6	68	75	56	18

<tbody>
</tbody>

The macro places all the data correctly in the second sheet with only one exception. Under the Week heading in the second sheet it omits the number 4 and 5.

I did start putting commenting into the macro, but the only two changes that I made to your code were as follows.

'* Define the two worksheets into two variable names for easier reference
Set w1 = Sheets("TeamData")
Set w2 = Sheets("Scores")

later

Ty

 

[hiker95]

Tyron,

The first sheet is called "TeamData" and the second sheet is called "Scores"

We have a new screenshot of worksheet TeamData with 6 weeks of raw data, and, 5 Teams.


In order to continue so that I can get it right this next time:

Please supply a screenshot of worksheet Scores, manually completed by you, for the results you are looking for.

 

[hiker95]

Tyron,

I found the problem, and, fixed it.

Sample raw data in worksheet TeamData:

Excel 2007
	A	B	C	D	E	F
1	Week	Team1	Team2	Team3	Team4	Team5
2	1	50	60		80	90
3	2	36	10	100	86	52
4	3	50	18	125		68
5	4	22		118	5	26
6	5		22	59	36	180
7	6	68	75	56	18
8
TeamData

After the macro in worksheet Scores:

Excel 2007
	A	B	C
1	Week	Team	Score
2	1	Team1	50
3		Team2	60
4		Team4	80
5		Team5	90
6	2	Team1	36
7		Team2	10
8		Team3	100
9		Team4	86
10		Team5	52
11	3	Team1	50
12		Team2	18
13		Team3	125
14		Team5	68
15	4	Team1	22
16		Team3	118
17		Team4	5
18		Team5	26
19	5	Team2	22
20		Team3	59
21		Team4	36
22		Team5	180
23	6	Team1	68
24		Team2	75
25		Team3	56
26		Team4	18
27
Scores

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub ReorgDataV2()
' hiker95, 09/04/2014, ME803110
Dim w1 As Worksheet, w2 As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long
Dim lr As Long, lc As Long, n As Long, n2 As Long, c As Long, s As Long
Application.ScreenUpdating = False
Set w1 = Sheets("TeamData")
Set w2 = Sheets("Scores")
With w1
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  n = Application.Count(.Range(.Cells(2, 2), .Cells(lr, lc))) + lr - 1
  ReDim o(1 To n + 1, 1 To 3)
End With
j = j + 1
o(j, 1) = "Week": o(j, 2) = "Team": o(j, 3) = "Score"
For i = 2 To lr
  n2 = Application.Count(w1.Range(w1.Cells(i, 2), w1.Cells(i, lc)))
  If n2 = 0 Then
    j = j + 1
    o(j, 1) = a(i, 1)
  ElseIf n2 > 0 Then
    s = 0
    For c = 2 To lc
      If a(i, c) <> "" And s = 0 Then
        j = j + 1
        o(j, 1) = a(i, 1)
        o(j, 2) = a(1, c)
        o(j, 3) = a(i, c)
        s = 1
      ElseIf a(i, c) <> "" And s = 1 Then
        j = j + 1
        o(j, 2) = a(1, c)
        o(j, 3) = a(i, c)
      End If
    Next c
  End If
Next i
With w2
  .UsedRange.ClearContents
  .Cells(1, 1).Resize(n + 1, 3).Value = o
  .Columns(1).Resize(, 3).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgDataV2 macro.

 

[Tyron]

Hey hiker95,

Excellent. Works like a charm. Takes care of the missing week number on the weeks where TEAM1 doesn't have a score as well. I tried changing all weeks to have no TEAM1 score and still works great.

Thanks again for your help.

later

Ty

 

[hiker95]

Tyron,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[Tyron]

Tyron,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

Hey hiker95,

You bet. I am still looking for good resource materials in order to answer my earlier questions. So far it is a bust. Won't be able to buy anything until xmas so the books are out and the youtube videos on excelisfun isn't going as easy as I had hoped because he doesn't sort his playlists by Formula and VBA. Most of his stuff is formula.

later

Ty

 

[hiker95]

Tyron,

I am still looking for good resource materials

See if anything in my most up to date list will help:

Training / Books / Sites as of 8/30/2014

http://www.mrexcel.com/forum/excel-...anging-columns-rows-advanced.html#post3925232

 

[Tyron]

Tyron,



See if anything in my most up to date list will help:

Training / Books / Sites as of 8/30/2014

http://www.mrexcel.com/forum/excel-...anging-columns-rows-advanced.html#post3925232

Hey hiker95,

Thanks. Actually since you listed it earlier I have been going down the list 1 by 1 to try and find what I am looking for.

From what I am finding it seems like most people are very helpful when it comes to getting code, but they aren't able to explain why they are doing it that way or why it works.

It is easy to learn the motions, but when you don't understand why you are doing it - you aren't really learning anything.

later

Ty

 

[Peter_SSs]

If you want another code to consider, I think this does the same job.

Sub ArrangeScores()
  Dim NumTeams As Long, NumWeeks As Long, w As Long, t As Long, k As Long
  Dim Data, Results
  
  Data = Sheets("TeamData").Range("A1").CurrentRegion.Value
  NumTeams = UBound(Data, 2) - 1
  NumWeeks = UBound(Data, 1) - 1
  ReDim Results(1 To NumTeams * NumWeeks, 1 To 3)
  k = 1
  For w = 2 To NumWeeks + 1
    Results(k, 1) = Data(w, 1)
    For t = 2 To NumTeams + 1
      If Data(w, t) <> "" Then
        Results(k, 2) = Data(1, t)
        Results(k, 3) = Data(w, t)
        k = k + 1
      End If
    Next t
    If Results(k, 1) <> "" Then k = k + 1
  Next w
  With Sheets("Scores")
    .UsedRange.ClearContents
    .Range("A2").Resize(NumTeams * NumWeeks, 3).Value = Results
    .Range("A1:C1").Value = Array("Week", "Team", "Score")
  End With
End Sub