First off, let me say that I am a novice when it comes to VBA. Since I can't seem to find any appropriate answers for my question, I thought I would post it here.
**********************
I have designed an Excel worksheet used for evaluating newsletters for a contest. The rows contain the elements that are being judged and there are 12 columns-one for each month of the year. I got tired of always having to scroll down the screen, so I split the sheet into two parts that are sitting side by side and separated by a blank column.
Let's say table A is three rows by three columns, and table B is three rows by three columns. Column A in table A and column E in table B are the results for the January evaluation. Similarly, column B in table A and column F in table B are the results for February and finally column C in table A and column G in table B are the March results.
My question is two fold.
1. Tab order-What I need is a way that when entering the data and tabbing through the evaluation form, Excel will tab as follow:
A1, A2, A3, E1, E2, E3
B1, B2, B3, F1, F2, F3
C1, C2, C3, G1, G2, G3 ...
2. Since there are twelve months in a year, I need to have the tab order change apply to all 12 columns.
Here is the code I use to generate the tabs:
***********************
Sub AddClubs()
'DEFINE VARIABLES HERE
Dim i As Integer, j As Integer
Dim ws1 As Worksheet, ws2 As Worksheet
Dim strX As String
Dim cel As Range
Dim Aws As Worksheet
Set Aws = Sheets("Awards")
' SET SETTINGS HERE
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set ws1 = Sheets("Awards")
Set ws2 = Sheets("Template")
'Check that frequency is filled in
For Each cel In Range("A2:A" & Aws.Range("A65536").End(xlUp).Row)
Debug.Print cel
If Cells(cel.Row, 3).Text = "" Then
MsgBox "Sorry you are missing Frequency Information"
Cells(cel.Row, 3).Activate ''added this line of code
Exit Sub
End If
Next
'DELETE ANY UNWANTED SHEETS IF THEY EXIST.
For i = Worksheets.Count To 1 Step -1
Debug.Print i
If Worksheets(i).Name <> "Awards" And Worksheets(i).Name <> "Template" Then
Worksheets(i).Delete
End If
Next
'unprotect Awards sheet
ws1.Unprotect "ooloo"
'START ADDING THE TEMPLATES HERE AND RENAME THEM. THEN ADD THE CELL VALUES AS DESIRED.
For i = 2 To ws1.Cells(65536, "A").End(xlUp).Row
Debug.Print i
Sheets("Template").Copy After:=Worksheets(Worksheets.Count)
Debug.Print Worksheets.Count
'strString = Replace(strString, " ", "")
ActiveSheet.Name = Replace(ActiveSheet.Name, " ", "_")
Debug.Print ActiveSheet.Name
ActiveSheet.Name = Left(ws1.Range("A" & i), 30)
ActiveSheet.Range("D2") = ws1.Range("A" & i)
ActiveSheet.Range("D1") = ws1.Range("B" & i)
ActiveSheet.Range("T1") = ws1.Range("C" & i) & " times a year"
strX = "='" & ActiveSheet.Name & "'!B53"
ws1.Range("D" & i) = strX
Next
Call CreateTableOfContents
End Sub
---------------------------------
Sub CreateTableOfContents()
Dim shtName As String
Dim shtLink As String
Dim rowNum As Integer
Dim colNum As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws As Worksheet
Dim i As Integer
'select Awards sheet
Set ws1 = Sheets("Awards")
Set ws2 = Sheets("Template")
ws1.Select
rowNum = 2
colNum = 1
'create hyperlinks
For i = 3 To Sheets.Count
'Does not create a link if the Sheet isn't visible or the sheet is the current sheet
If Sheets(i).Visible = True Then
shtName = Sheets(i).Name
Debug.Print shtName
shtLink = "'" & shtName & "'!E7"
ws1.Cells(rowNum, colNum).Select
'inserts the hyperlink to the sheet and cell A1
ActiveSheet.hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=shtLink, TextToDisplay:=shtName
rowNum = rowNum + 1
End If
Next i
'set font & border
Range("A2:D50").Font.Name = "Arial"
Range("A2:D50").Font.Size = 11
Range("A2:D50").Font.Bold = True
Range("A2:A50").Font.Color = vbRed
Range("B2:D50").Font.Color = vbBlack
Range("A:A").Font.underline = xlUnderlineStyleNone
Range("A2:D50").RowHeight = 20
'Worksheets("Awards").Columns("A:D").AutoFit
Range("A2:D50").VerticalAlignment = xlCenter
Range("A2:B50").HorizontalAlignment = xlLeft
Range("C2:D50").HorizontalAlignment = xlCenter
'borders
Sheets("Awards").Select
Range("A2:D50").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'RESTORE ALL SETTINGS BACK HERE
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox ("Done!")
'hide column F;Show column H
Columns("F:F").Select
Selection.EntireColumn.Hidden = True
Columns("H:H").Select
Selection.EntireColumn.Hidden = False
'Protect Awards Sheet
Worksheets("Awards").Range("A2:D50").Locked = False
ws1.Protect "ooloo"
'hide Template
ws2.Visible = False
ws1.Select
Range("A2").Select
End Sub
--------------------------------------
Private Sub Worksheet_Activate()
Cells(2, 1).Select
End Sub
*******************************************
Hope that makes sense. Any help would be greatly appreciated.
**********************
I have designed an Excel worksheet used for evaluating newsletters for a contest. The rows contain the elements that are being judged and there are 12 columns-one for each month of the year. I got tired of always having to scroll down the screen, so I split the sheet into two parts that are sitting side by side and separated by a blank column.
Let's say table A is three rows by three columns, and table B is three rows by three columns. Column A in table A and column E in table B are the results for the January evaluation. Similarly, column B in table A and column F in table B are the results for February and finally column C in table A and column G in table B are the March results.
My question is two fold.
1. Tab order-What I need is a way that when entering the data and tabbing through the evaluation form, Excel will tab as follow:
A1, A2, A3, E1, E2, E3
B1, B2, B3, F1, F2, F3
C1, C2, C3, G1, G2, G3 ...
2. Since there are twelve months in a year, I need to have the tab order change apply to all 12 columns.
Here is the code I use to generate the tabs:
***********************
Sub AddClubs()
'DEFINE VARIABLES HERE
Dim i As Integer, j As Integer
Dim ws1 As Worksheet, ws2 As Worksheet
Dim strX As String
Dim cel As Range
Dim Aws As Worksheet
Set Aws = Sheets("Awards")
' SET SETTINGS HERE
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set ws1 = Sheets("Awards")
Set ws2 = Sheets("Template")
'Check that frequency is filled in
For Each cel In Range("A2:A" & Aws.Range("A65536").End(xlUp).Row)
Debug.Print cel
If Cells(cel.Row, 3).Text = "" Then
MsgBox "Sorry you are missing Frequency Information"
Cells(cel.Row, 3).Activate ''added this line of code
Exit Sub
End If
Next
'DELETE ANY UNWANTED SHEETS IF THEY EXIST.
For i = Worksheets.Count To 1 Step -1
Debug.Print i
If Worksheets(i).Name <> "Awards" And Worksheets(i).Name <> "Template" Then
Worksheets(i).Delete
End If
Next
'unprotect Awards sheet
ws1.Unprotect "ooloo"
'START ADDING THE TEMPLATES HERE AND RENAME THEM. THEN ADD THE CELL VALUES AS DESIRED.
For i = 2 To ws1.Cells(65536, "A").End(xlUp).Row
Debug.Print i
Sheets("Template").Copy After:=Worksheets(Worksheets.Count)
Debug.Print Worksheets.Count
'strString = Replace(strString, " ", "")
ActiveSheet.Name = Replace(ActiveSheet.Name, " ", "_")
Debug.Print ActiveSheet.Name
ActiveSheet.Name = Left(ws1.Range("A" & i), 30)
ActiveSheet.Range("D2") = ws1.Range("A" & i)
ActiveSheet.Range("D1") = ws1.Range("B" & i)
ActiveSheet.Range("T1") = ws1.Range("C" & i) & " times a year"
strX = "='" & ActiveSheet.Name & "'!B53"
ws1.Range("D" & i) = strX
Next
Call CreateTableOfContents
End Sub
---------------------------------
Sub CreateTableOfContents()
Dim shtName As String
Dim shtLink As String
Dim rowNum As Integer
Dim colNum As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws As Worksheet
Dim i As Integer
'select Awards sheet
Set ws1 = Sheets("Awards")
Set ws2 = Sheets("Template")
ws1.Select
rowNum = 2
colNum = 1
'create hyperlinks
For i = 3 To Sheets.Count
'Does not create a link if the Sheet isn't visible or the sheet is the current sheet
If Sheets(i).Visible = True Then
shtName = Sheets(i).Name
Debug.Print shtName
shtLink = "'" & shtName & "'!E7"
ws1.Cells(rowNum, colNum).Select
'inserts the hyperlink to the sheet and cell A1
ActiveSheet.hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=shtLink, TextToDisplay:=shtName
rowNum = rowNum + 1
End If
Next i
'set font & border
Range("A2:D50").Font.Name = "Arial"
Range("A2:D50").Font.Size = 11
Range("A2:D50").Font.Bold = True
Range("A2:A50").Font.Color = vbRed
Range("B2:D50").Font.Color = vbBlack
Range("A:A").Font.underline = xlUnderlineStyleNone
Range("A2:D50").RowHeight = 20
'Worksheets("Awards").Columns("A:D").AutoFit
Range("A2:D50").VerticalAlignment = xlCenter
Range("A2:B50").HorizontalAlignment = xlLeft
Range("C2:D50").HorizontalAlignment = xlCenter
'borders
Sheets("Awards").Select
Range("A2:D50").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'RESTORE ALL SETTINGS BACK HERE
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox ("Done!")
'hide column F;Show column H
Columns("F:F").Select
Selection.EntireColumn.Hidden = True
Columns("H:H").Select
Selection.EntireColumn.Hidden = False
'Protect Awards Sheet
Worksheets("Awards").Range("A2:D50").Locked = False
ws1.Protect "ooloo"
'hide Template
ws2.Visible = False
ws1.Select
Range("A2").Select
End Sub
--------------------------------------
Private Sub Worksheet_Activate()
Cells(2, 1).Select
End Sub
*******************************************
Hope that makes sense. Any help would be greatly appreciated.