Checkboxes

[elsone31]

The Checkbox sub in the code below works sometimes and sometimes it does not. If is step through using F8 it works everytime, but if I just run the code in entirety, it does not work. Yesterday it did, today it is being ornary. Any help is greatly appreciated.


Sub Grades()
Dim j As Long
Dim lastrow As Integer
Dim IDRange2 As Range




For j = 1 To 1013 Step 9


Application.DisplayAlerts = False
Worksheets("Template").Copy After:=Worksheets("Template")




lastrow = j + 8
Worksheets("Grades").Select

Worksheets("Template (2)").Range("G1") = Worksheets("Grades").Cells(j, 1).Value

Worksheets("Grades").Cells(j, 1).Select
Range(Cells(j, 2), Cells(lastrow, 11)).Copy
Worksheets("Template (2)").Select
Range("D12:M20").PasteSpecial

IDNum2 = Worksheets("Template (2)").Range("G1").Value
Worksheets("Info").Select

Set IDRange2 = Sheets("Info").Range("B2:B43").Find(What:=IDNum2, Lookat:=xlWhole)

If IDRange2 Is Nothing Then
Else
IDRange2.Select
End If

RowNum2 = ActiveCell.Row

Worksheets("Template (2)").Range("A2") = Worksheets("Info").Cells(RowNum2, 1).Value
Worksheets("Template (2)").Range("G2") = Worksheets("Info").Cells(RowNum2, 3).Value
Worksheets("Template (2)").Range("A4") = Worksheets("Info").Cells(RowNum2, 4).Value
Worksheets("Template (2)").Range("F4") = Worksheets("Info").Cells(RowNum2, 5).Value
Worksheets("Template (2)").Range("A6") = Worksheets("Info").Cells(RowNum2, 10).Value & " " & Worksheets("Info").Cells(RowNum2, 11).Value
Worksheets("Template (2)").Range("D6") = Worksheets("Info").Cells(RowNum2, 12).Value
Worksheets("Template (2)").Range("E6") = Worksheets("Info").Cells(RowNum2, 13).Value
Worksheets("Template (2)").Range("F6") = Worksheets("Info").Cells(RowNum2, 8).Value
Worksheets("Template (2)").Range("A9") = Worksheets("Info").Cells(RowNum2, 6).Value
Worksheets("Template (2)").Range("D9") = Worksheets("Info").Cells(RowNum2, 14).Value
Worksheets("Template (2)").Range("B12") = Worksheets("Info").Cells(RowNum2, 19).Value
Worksheets("Template (2)").Range("B13") = Worksheets("Info").Cells(RowNum2, 20).Value
Worksheets("Template (2)").Range("B14") = Worksheets("Info").Cells(RowNum2, 21).Value

Call Check_boxes
Call staar_data
Call AddPicture

Worksheets("TEMPLATE (2)").Select
ActiveSheet.Name = "Student History"
'
'Create new workbook and rename tab
'Worksheets("Student History").Range("A33:H35").Copy
'Worksheets("Student History").Range("A33:H35").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'ActiveSheet.Move


'Save file


Dim Path As String
Dim FileName As String
Dim Campus As String






Path = "Q:\ASSESSMENT\MIDDLE SCHOOLS\HERNANDEZ\ACADEMIC DATA ANALYSIS\ACADEMIC FACILITATORS\STUDENT DATA SHEETS\7th GRADE\"
FileName = Range("A2")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="Q:\ASSESSMENT\MIDDLE SCHOOLS\HERNANDEZ\ACADEMIC DATA ANALYSIS\ACADEMIC FACILITATORS\STUDENT DATA SHEETS\7th GRADE\ " & FileName
'ActiveWorkbook.SaveAs FileName:=Path & FileName
Worksheets("Student History").Delete


Application.DisplayAlerts = True


Next j
End Sub
Sub staar_data()
Dim RowNum As Integer
Dim IDRange As Range


'IDNum = Range("B2").Value






IDNum = Worksheets("Template (2)").Range("G1").Value




Worksheets("STAAR").Select
Set FoundRange = Sheets("STAAR").Range("C2:C41").Find(What:=IDNum, Lookat:=xlWhole)
If FoundRange Is Nothing Then
Else: FoundRange.Select
End If

RowNum = ActiveCell.Row


Worksheets("STAAR").Range(Cells(RowNum, 5), Cells(RowNum, 12)).Copy
Worksheets("Template (2)").Range("B23").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True

Worksheets("STAAR").Range(Cells(RowNum, 14), Cells(RowNum, 21)).Copy
Worksheets("Template (2)").Range("C23").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True

Worksheets("STAAR").Range(Cells(RowNum, 23), Cells(RowNum, 30)).Copy
Worksheets("Template (2)").Range("D23").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True

Worksheets("STAAR").Range(Cells(RowNum, 32), Cells(RowNum, 39)).Copy
Worksheets("Template (2)").Range("E23").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True

Worksheets("STAAR").Range(Cells(RowNum, 41), Cells(RowNum, 48)).Copy
Worksheets("Template (2)").Range("F23").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True

Worksheets("STAAR").Range(Cells(RowNum, 50), Cells(RowNum, 57)).Copy
Worksheets("Template (2)").Range("G23").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True

Worksheets("STAAR").Range(Cells(RowNum, 59), Cells(RowNum, 66)).Copy
Worksheets("Template (2)").Range("H23").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True

Worksheets("STAAR").Range(Cells(RowNum, 68), Cells(RowNum, 75)).Copy
Worksheets("Template (2)").Range("I23").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True

Worksheets("STAAR").Range(Cells(RowNum, 77), Cells(RowNum, 84)).Copy
Worksheets("Template (2)").Range("J23").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
End Sub
Sub AddPicture()
Dim myDir As String
Dim Student As String
Dim T As String
Application.ScreenUpdating = False

Worksheets("TEMPLATE (2)").Activate

myDir = "Q:\ASSESSMENT\MIDDLE SCHOOLS\HERNANDEZ\ACADEMIC DATA ANALYSIS\ACADEMIC FACILITATORS\PICTURES\"
Student = Range("G1")
T = ".jpg"


'myDir = "C:\Users\Daddy\MYspace Documents\MYspace Pictures\" ' ------------- trailing backslash
'Student = "Dilbert"
'T = ".jpg"

'MsgBox myDir & Student & T ' ------------------ helpful to debug

ActiveSheet.Shapes.AddPicture FileName:=myDir & Student & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=565, Top:=10, Width:=120, Height:=120

Application.ScreenUpdating = True

End Sub
Sub Check_boxes()
Dim Language As Boolean
Dim Language2 As Boolean
Dim Language3 As Boolean
Dim SpEd As Boolean
Dim ELL As Boolean
Dim Fiveohfour As Boolean







IDNum = Worksheets("Template (2)").Range("G1").Value

Worksheets("Info").Select

Set IDRange = Sheets("Info").Range("B2:B43").Find(What:=IDNum, Lookat:=xlWhole)

If IDRange Is Nothing Then
Else: IDRange.Select
RowNum = ActiveCell.Row

If Worksheets("Info").Cells(RowNum, 15).Value = "English" Then
Language = True
Else

If Worksheets("Info").Cells(RowNum, 15).Value = "Spanish" Then
Language2 = True
Else
Language3 = True
End If
End If
If Language = True Then
Worksheets("Template (2)").CheckBox2.Value = xlOn
Else
If Language2 = True Then
Worksheets("Template (2)").CheckBox1.Value = xlOn
Else
Language3 = True
Worksheets("Template (2)").CheckBox3.Value = xlOn
End If
End If



If Worksheets("Info").Cells(RowNum, 16).Value = "Y" Then
SpEd = True
End If

If SpEd = True Then
Worksheets("Template (2)").CheckBox4.Value = xlOn
End If

If Worksheets("Info").Cells(RowNum, 17).Value = "Y" Then
ELL = True
End If

If ELL = True Then
Worksheets("Template (2)").CheckBox5.Value = xlOn
End If

If Worksheets("Info").Cells(RowNum, 18).Value = "Y" Then
Fiveohfour = True
End If

If Fiveohfour = True Then
Worksheets("Template (2)").CheckBox6.Value = xlOn
End If
End If


End Sub

[mana]

Please try this, although I can't understand your code.


Option Explicit

Sub Grades()
Dim j As Long
Dim ws As Worksheet
Dim Student As String
Dim RowNum
Dim Path As String

For j = 1 To 1013 Step 9

Worksheets("Template").Copy After:=Worksheets("Template")
Set ws = ActiveSheet

ws.Range("G1").Value = Worksheets("Grades").Cells(j, 1).Value

Worksheets("Grades").Cells(j, 2).Resize(9, 10).Copy ws.Range("D12:M20")

Student = ws.Range("G1").Value

On Error Resume Next
RowNum = Application.Match(Student, Sheets("Info").Range("B1:B43"), 0)
On Error GoTo 0
If IsNumeric(RowNum) Then

ws.Range("A2") = Worksheets("Info").Cells(RowNum, 1).Value
ws.Range("G2") = Worksheets("Info").Cells(RowNum, 3).Value
ws.Range("A4") = Worksheets("Info").Cells(RowNum, 4).Value
ws.Range("F4") = Worksheets("Info").Cells(RowNum, 5).Value
ws.Range("A6") = Worksheets("Info").Cells(RowNum, 10).Value & " " & Worksheets("Info").Cells(RowNum, 11).Value
ws.Range("D6") = Worksheets("Info").Cells(RowNum, 12).Value
ws.Range("E6") = Worksheets("Info").Cells(RowNum, 13).Value
ws.Range("F6") = Worksheets("Info").Cells(RowNum, 8).Value
ws.Range("A9") = Worksheets("Info").Cells(RowNum, 6).Value
ws.Range("D9") = Worksheets("Info").Cells(RowNum, 14).Value
ws.Range("B12") = Worksheets("Info").Cells(RowNum, 19).Value
ws.Range("B13") = Worksheets("Info").Cells(RowNum, 20).Value
ws.Range("B14") = Worksheets("Info").Cells(RowNum, 21).Value

Call Check_boxes(ws, RowNum)
Call staar_data(ws, RowNum)
Call AddPicture(ws)

'Save file
Path = "Q:\ASSESSMENT\MIDDLE SCHOOLS\HERNANDEZ\ACADEMIC DATA ANALYSIS\ACADEMIC FACILITATORS\STUDENT DATA SHEETS\7th GRADE\"
ws.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Path & ws.Range("A2")

End If

Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True

Next j

End Sub


Sub Check_boxes(ws As Worksheet, r)

If Worksheets("Info").Cells(r, 15).Value = "English" Then
ws.CheckBox2.Value = xlOn
ElseIf Worksheets("Info").Cells(r, 15).Value = "Spanish" Then
ws.CheckBox1.Value = xlOn
Else
ws.CheckBox3.Value = xlOn
End If

If Worksheets("Info").Cells(r, 16).Value = "Y" Then
ws.CheckBox4.Value = xlOn
End If

If Worksheets("Info").Cells(r, 17).Value = "Y" Then
ws.CheckBox5.Value = xlOn
End If

If Worksheets("Info").Cells(r, 18).Value = "Y" Then
ws.CheckBox6.Value = xlOn
End If

End Sub


Sub staar_data(ws As Worksheet, r)
Dim i As Long, n As Long

For i = 5 To 77 Step 9
Worksheets("STAAR").Cells(r, 5).Resize(, 8).Copy
ws.Range("B23").Offset(, n).PasteSpecial Paste:=xlPasteAllExceptBorders, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
n = n + 1
Next

End Sub

Sub AddPicture(ws As Worksheet)
Dim myDir As String
Dim Student As String
Dim T As String

Application.ScreenUpdating = False

myDir = "Q:\ASSESSMENT\MIDDLE SCHOOLS\HERNANDEZ\ACADEMIC DATA ANALYSIS\ACADEMIC FACILITATORS\PICTURES\"
Student = ws.Range("G1").Value
T = ".jpg"

'MsgBox myDir & Student & T ' ------------------ helpful to debug

ws.Shapes.AddPicture FileName:=myDir & Student & T, _
linktofile:=msoFalse, savewithdocument:=msoTrue, _
Left:=565, Top:=10, Width:=120, Height:=120

Application.ScreenUpdating = True

End Sub

[elsone31]

I get that alot, my job has blown up with the amount of data I have to put together for campuses and I have just been peice milling macros together. I will be taking classes soon. That did not work, but thank you so much for replying.

I manually ran it so I will close this thread and when I get some real skills here soon I will probably laugh at these early macros.