Hi,
This is my first attempt at writing code from scratch without using the recorder.
The code does what I want it to do but I would like to know if there is a way of shortening it.
I need to extract data from a sheet and paste into individual location sheets.
I need the code to run in Excel 2003 and 2007.
The code looks up the location in the "Data" sheet, if the row is in group "S" then the data is copied and pasted into the relevant sheet against the correct week and day.
The Week and Day are selected from the "Summary" sheet:
Excel 2007
<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
<tbody>
</tbody>
The data sheet looks like:
Excel 2007
<colgroup><col style="width: 25pxpx"><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
This data, when transferred to the location sheet looks like:
Excel 2007
<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
My code looks like:
All location sheets are set out the same with 4 rows per week but I would like to add a formula to the code so it looks up the week number in each of the sheets in case I have to add a row later in the year.
I hope I have explained what I'm looking for well enough.
This is my first attempt at writing code from scratch without using the recorder.
The code does what I want it to do but I would like to know if there is a way of shortening it.
I need to extract data from a sheet and paste into individual location sheets.
I need the code to run in Excel 2003 and 2007.
The code looks up the location in the "Data" sheet, if the row is in group "S" then the data is copied and pasted into the relevant sheet against the correct week and day.
The Week and Day are selected from the "Summary" sheet:
Excel 2007
A | B | C | D | E | F | G | H | I | |
---|---|---|---|---|---|---|---|---|---|
1 | Row Count: | 15 | |||||||
2 | Week | Total across all locations | Week to Import: | 1 | Day to Import: | Sun - Mon | |||
3 | 1 | 92 |
<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Summary
Worksheet Formulas
<thead> </thead><tbody> </tbody> |
<tbody>
</tbody>
The data sheet looks like:
Excel 2007
A | B | C | D | |
---|---|---|---|---|
1 | Day | Location | Group | Number |
2 | Mon - Tue | 2166 | S | 1 |
3 | Mon - Tue | 2166 | S | 2 |
4 | Mon - Tue | 2218 | 3 | |
5 | Mon - Tue | 2218 | S | 4 |
<colgroup><col style="width: 25pxpx"><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Data
This data, when transferred to the location sheet looks like:
Excel 2007
A | B | C | D | E | F | G | H | I | |
---|---|---|---|---|---|---|---|---|---|
3 | Sun - Mon | Mon - Tue | Tue - Wed | Wed - Thu | Thu - Fri | Fri - Sat | Sat - Sun | ||
4 | Week | 1 | 1 | ||||||
5 | 2 | ||||||||
6 | |||||||||
7 |
<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
2166
My code looks like:
Code:
Sub NumbersToLocations()
'if the location (column B in the Data sheet) matches the sheet name and there is an "S" in column 3 then
'copy the number (column D) and paste into the location sheet
'loop through all rows in Data sheet and all location sheets
Dim r As Integer 'r is the row number the data is being copied from
Dim rn As Integer 'rn is the row number to paste the first result - decided by the week number, cell G2 in the Summary sheet
Dim cn As Integer 'cn is the column number to paste the 1st result - decided by the day, cell I2 in the Summary sheet
Dim count As Integer 'count is counting the number of sheets in the workbook
Dim os As Integer 'os is the row number offset to use when pasting 2nd, 3rd and 4th results
Dim wsn As Integer 'wsn is the work sheet name to paste into
Dim boxes As Integer 'boxes is the number to paste
Dim lastrow As Integer 'lastrow is the number of rows to loop through, it is a counta sum in cell B1 in the Summary sheet
Worksheets("Summary").Activate
lastrow = Cells(1, 2)
'what week number is being run?
'which row does the data need pasting into?
If Cells(2, 7) = 1 Then
rn = 4
End If
If Cells(2, 7) = 2 Then
rn = 8
End If
If Cells(2, 7) = 3 Then
rn = 12
End If
If Cells(2, 7) = 4 Then
rn = 16
End If
If Cells(2, 7) = 5 Then
rn = 20
End If
If Cells(2, 7) = 6 Then
rn = 24
End If
If Cells(2, 7) = 7 Then
rn = 28
End If
If Cells(2, 7) = 8 Then
rn = 32
End If
If Cells(2, 7) = 9 Then
rn = 36
End If
If Cells(2, 7) = 10 Then
rn = 40
End If
If Cells(2, 7) = 11 Then
rn = 44
End If
If Cells(2, 7) = 12 Then
rn = 48
End If
If Cells(2, 7) = 13 Then
rn = 52
End If
If Cells(2, 7) = 14 Then
rn = 56
End If
If Cells(2, 7) = 15 Then
rn = 60
End If
If Cells(2, 7) = 16 Then
rn = 64
End If
If Cells(2, 7) = 17 Then
rn = 68
End If
If Cells(2, 7) = 18 Then
rn = 72
End If
If Cells(2, 7) = 19 Then
rn = 76
End If
If Cells(2, 7) = 20 Then
rn = 80
End If
If Cells(2, 7) = 21 Then
rn = 84
End If
If Cells(2, 7) = 22 Then
rn = 88
End If
If Cells(2, 7) = 23 Then
rn = 92
End If
If Cells(2, 7) = 24 Then
rn = 96
End If
If Cells(2, 7) = 25 Then
rn = 100
End If
If Cells(2, 7) = 26 Then
rn = 104
End If
If Cells(2, 7) = 27 Then
rn = 108
End If
If Cells(2, 7) = 28 Then
rn = 112
End If
If Cells(2, 7) = 29 Then
rn = 116
End If
If Cells(2, 7) = 30 Then
rn = 120
End If
If Cells(2, 7) = 31 Then
rn = 124
End If
If Cells(2, 7) = 32 Then
rn = 128
End If
If Cells(2, 7) = 33 Then
rn = 132
End If
If Cells(2, 7) = 34 Then
rn = 136
End If
If Cells(2, 7) = 35 Then
rn = 140
End If
If Cells(2, 7) = 36 Then
rn = 144
End If
If Cells(2, 7) = 37 Then
rn = 148
End If
If Cells(2, 7) = 38 Then
rn = 152
End If
If Cells(2, 7) = 39 Then
rn = 156
End If
If Cells(2, 7) = 40 Then
rn = 160
End If
If Cells(2, 7) = 41 Then
rn = 164
End If
If Cells(2, 7) = 42 Then
rn = 168
End If
If Cells(2, 7) = 43 Then
rn = 172
End If
If Cells(2, 7) = 44 Then
rn = 176
End If
If Cells(2, 7) = 45 Then
rn = 180
End If
If Cells(2, 7) = 46 Then
rn = 184
End If
If Cells(2, 7) = 47 Then
rn = 188
End If
If Cells(2, 7) = 48 Then
rn = 192
End If
If Cells(2, 7) = 49 Then
rn = 196
End If
If Cells(2, 7) = 50 Then
rn = 200
End If
If Cells(2, 7) = 51 Then
rn = 204
End If
If Cells(2, 7) = 52 Then
rn = 208
End If
If Cells(2, 7) = 53 Then
rn = 212
End If
'what report/day is being run?
'which column does the data need pasting into?
If Cells(2, 9) = "Sun - Mon" Then
cn = 3
End If
If Cells(2, 9) = "Mon - Tue" Then
cn = 4
End If
If Cells(2, 9) = "Tue - Wed" Then
cn = 5
End If
If Cells(2, 9) = "Wed - Thu" Then
cn = 6
End If
If Cells(2, 9) = "Thu - Fri" Then
cn = 7
End If
If Cells(2, 9) = "Fri - Sat" Then
cn = 8
End If
If Cells(2, 9) = "Sat - Sun" Then
cn = 9
End If
For ws = 3 To Worksheets.count
Worksheets(ws).Activate
wsn = ActiveSheet.Name
os = 0
Worksheets("Data").Activate
For r = 2 To lastrow
Worksheets("Data").Activate
If Cells(r, 2) = wsn And Cells(r, 3) = "S" Then
boxes = Cells(r, 4)
Worksheets(ws).Activate
Cells(rn + os, cn) = boxes
os = os + 1
End If
Next r
Next ws
End Sub
All location sheets are set out the same with 4 rows per week but I would like to add a formula to the code so it looks up the week number in each of the sheets in case I have to add a row later in the year.
I hope I have explained what I'm looking for well enough.