Skooter867,
I added a button to your ALPHA LIST worksheet labelled Make Alpha
List. When you click it, Your Alpha List will populate from the other
nine worksheets, sort, total and format. The code behind the button is
pasted below. You can also see it by pressing Alt-F11 in your workbook
to open the code editor. Note that you may have to adjust your
security settings to allow the macro to run.
If you prefer, you can paste the macro into your own workbook(s) and
assign it to a button, hotkey or simply run it from the code editor.
If you do no, note that no line of code should wrap. The Answer box
may wrap lines. These will need to be unwrapped before the code will
run.
You can download the Excel file from here:
http://www.hammerdata.com/Google/CollectionWorksheetTemplate.xls
Please let me know if you have any questions.
Good luck with your Excel project!
- Hammer
' CODE BEGIN
Sub GetAlphaList()
Dim iLoop As Integer
Dim iLoopIn As Integer
Dim iCopy As Integer
Dim iRow As Integer
Dim iLastRow As Integer
Dim wks As Worksheet
Dim cwks As Worksheet
Dim rng As Range
Dim srng As Range
iRow = 4
Set wks = ThisWorkbook.Worksheets("ALPHA LIST")
' Do each of the nine individual worksheets
For iLoop = 1 To 9
Set cwks = ThisWorkbook.Worksheets(iLoop)
' Publishers section
For iCopy = 5 To 31
If Len(cwks.Cells(iCopy, 1).Value) > 0 Then
For iLoopIn = 1 To 9
wks.Cells(iRow, iLoopIn).Value = cwks.Cells(iCopy,
iLoopIn).Value
Next iLoopIn
iRow = iRow + 1
End If
Next iCopy
' Late reports section
For iCopy = 36 To 45
If Len(cwks.Cells(iCopy, 1).Value) > 0 Then
For iLoopIn = 1 To 9
wks.Cells(iRow, iLoopIn).Value = cwks.Cells(iCopy,
iLoopIn).Value
Next iLoopIn
iRow = iRow + 1
End If
Next iCopy
' Regular Pioneers section
For iCopy = 56 To 59
If Len(cwks.Cells(iCopy, 1).Value) > 0 Then
For iLoopIn = 1 To 9
wks.Cells(iRow, iLoopIn).Value = cwks.Cells(iCopy,
iLoopIn).Value
Next iLoopIn
iRow = iRow + 1
End If
Next iCopy
' Auxiliary Pioneers section
For iCopy = 66 To 73
If Len(cwks.Cells(iCopy, 1).Value) > 0 Then
For iLoopIn = 1 To 9
wks.Cells(iRow, iLoopIn).Value = cwks.Cells(iCopy,
iLoopIn).Value
Next iLoopIn
iRow = iRow + 1
End If
Next iCopy
Next iLoop
' Sort data
iLastRow = iRow - 1
Set rng = wks.Range(Cells(4, 1), Cells(iLastRow, 9))
Set srng = wks.Range(Cells(4, 1), Cells(iLastRow, 1))
rng.Sort srng, xlAscending, , , , , , xlNo
' Total data
wks.Cells(iRow, 1).Value = "TOTALS"
For iLoop = 3 To 8
Set srng = wks.Range(Cells(4, iLoop), Cells(iLastRow, iLoop))
wks.Cells(iRow, iLoop).Value = Application.WorksheetFunction.Sum(srng)
Next iLoop
' Format borders, alignment and fonts
Set rng = wks.Range(Cells(4, 1), Cells(iRow, 9))
rng.Borders.LineStyle = xlContinuous
rng.Borders.Weight = xlThin
rng.Range(Cells(4, 1), Cells(iRow, 1)).HorizontalAlignment = xlLeft
rng.Range(Cells(4, 9), Cells(iRow, 9)).HorizontalAlignment = xlLeft
rng.Range(Cells(4, 2), Cells(iRow, 8)).HorizontalAlignment = xlCenter
rng.Font.Bold = False
Set rng = wks.Range(Cells(iRow, 1), Cells(iRow, 9))
rng.Font.Bold = True
'Clean up
Set wks = Nothing
Set cwks = Nothing
Set rng = Nothing
Set srng = Nothing
End Sub |
,
0 Comments
)