elsone31
08-31-2016, 05:52 PM
I have been trying to get this worked out for almost a week now and it is time to turn to those greater than I am. I am attaching my workbook as well.
I have this code that does a great job moving the data to the template and saving to the directory. Turned days worth of manual copy paste into a mere 15 minutes. Two issues I can not get to work. 1.Getting the buttons for sorting the periods to re-assign to the the new workbook, 2. using my hide empty columns macro to work. the reason I believe is because I just had the code to write our 40 columns of data regardless of how many students were in each period. I did this because the sort buttons are hard coded for those cell ranges. Any help is GREATLY appreciated. I am using Excel 2010.
Sub create_file()
Dim student_array(82, 39) As Variant
Dim eof_flag As String
Dim eoc_flag As String
Dim eot_flag As String
Dim t_name As String
Dim s_nbr As Long
Dim c_nbr As String
Dim per As Integer
Dim i As Integer
Dim j As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim j2 As Integer
Dim tchr_tab_row As Integer
Dim data_tab_col As Integer
Dim per_col As Integer
Dim max_row As Integer
eof_flag = "no"
eoc_flag = "no"
eot_flag = "no"
Dim FileName As Variant
Dim Campus As String
'
'get a teacher name
'
Worksheets("teacher tab").Select
teacher_tab_row = 1
'max_row has maximum number of rows on data tab
max_row = 82
c_nbr = Cells(teacher_tab_row, 1)
t_name = Cells(teacher_tab_row, 2)
Do While eof_flag <> "yes"
Worksheets("data tab").Select
i = 1
Worksheets("teacher tab").Select
Campus_Name = Cells(teacher_tab_row, 3)
File_Name = Cells(teacher_tab_row, 4)
Worksheets("data tab").Select
i = 1
'
' look for teacher in data tab
'
Do While eot_flag <> "yes"
If (((t_name = Cells(2, i)) And (c_nbr = Cells(4, i))) Or (Cells(2, i) = "")) Then
eot_flag = "yes"
Else
i = i + 1
End If
Loop
'
If Cells(2, i) <> "" Then
eot_flag = "found"
End If
'
'teacher has been found
'
data_tab_col = i
template_tab_col = 6
j2 = data_tab_col
per = Cells(3, j2)
Do While eot_flag = "found"
'
'zero out array to prepare for data
'
GoSub zero_out_array
'
'this is a nested loop for reading in the data from the data tab
'
For j = 1 To 39
'
'keep moving data into array as long as the teacher and the period and the campus is the same
' otherwise, jump out
'
If (Cells(2, j2) = t_name And Cells(4, j2) = c_nbr And Cells(3, j2) = per) Then
i2 = 1
For i = 1 To max_row
student_array(i, j) = Cells(i2, j2)
i2 = i2 + 1
Next
j2 = j2 + 1
Else
j = 40
End If
Next
'
'here is where we will move the data to the new sheet
'
Worksheets("template tab").Select
per_col = template_tab_col
For j = 1 To 39
i2 = 1
For i = 1 To max_row
Cells(i2, per_col) = student_array(i, j)
i2 = i2 + 1
Next
per_col = per_col + 1
Next
'
'if the teacher has another period, then switch to new period
'
Worksheets("data tab").Select
If Cells(2, j2) = t_name Then
per = Cells(3, j2)
template_tab_col = template_tab_col + 40
Else
eot_flag = "no"
End If
Loop
'
'get another teacher name
'
'this is where we will write out the template to finish off the teacher
Worksheets("template tab").Select
ActiveSheet.Copy
Dim Path As String
Campus = Campus_Name
Path = "Q:\ASSESSMENT\MIDDLE SCHOOLS\" & Campus & "\STUDENT PERFORMANCE TRACKERS\2016-2017\"
FileName = FileName_File_Name
ActiveWorkbook.SaveAs FileName:="Q:\ASSESSMENT\MIDDLE SCHOOLS\" & Campus & "\STUDENT PERFORMANCE TRACKERS\2016-2017\ " & File_Name & ".xlsm", FileFormat:=52
ActiveWorkbook.Close SaveChanges:=True
GoSub blank_template_sheet
'
GoSub search_tchr_tab
If eof_flag <> "yes" Then
eot_flag = "no"
End If
'
Loop
Exit Sub
search_tchr_tab:
Worksheets("teacher tab").Select
teacher_tab_row = teacher_tab_row + 1
c_nbr = Cells(teacher_tab_row, 1)
t_name = Cells(teacher_tab_row, 2)
If c_nbr = "" Then
eof_flag = "yes"
End If
Return
zero_out_array:
For j = 1 To 39
For i = 1 To max_row
student_array(i, j) = ""
Next
Next
Return
blank_template_sheet:
Worksheets("template tab").Select
Range("F1:AR100").ClearContents
Range("AT1:CF100").ClearContents
Range("CH1:DT100").ClearContents
Range("DV1:FH100").ClearContents
Range("FJ1:GV100").ClearContents
Range("GX1:IK100").ClearContents
Return
End Sub
Code for sorting this works fine, but wanted to share as this is the code connected to the buttons.16983
Sub Button1_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("F:AS").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("F" & myvalue & ":AS" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("F" & myvalue & ":AS" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("F" & myvalue & ":AS" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("F" & myvalue & ":AS" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("F" & myvalue & ":AS" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, _
254, 206)
.SetRange ActiveSheet.Range("F1:AS95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub
Sub Button2_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("AT:CG").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("AT" & myvalue & ":CG" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("AT" & myvalue & ":CG" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("AT" & myvalue & ":CG" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("AT" & myvalue & ":CG" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("AT" & myvalue & ":CG" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, _
254, 206)
.SetRange ActiveSheet.Range("AT1:CG95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub
Sub Button3_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("CH:DU").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("CH" & myvalue & ":DU" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("CH" & myvalue & ":DU" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("CH" & myvalue & ":DU" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("CH" & myvalue & ":DU" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("CH" & myvalue & ":DU" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, _
254, 206)
.SetRange ActiveSheet.Range("CH1:DU95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub
Sub Button4_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("DV:FI").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("DV" & myvalue & ":FI" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("DV" & myvalue & ":FI" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("DV" & myvalue & ":FI" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("DV" & myvalue & ":FI" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("DV" & myvalue & ":FI" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, 254, 206)
.SetRange ActiveSheet.Range("DV1:FI95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub
Sub Button5_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("FJ:GW").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("FJ" & myvalue & ":GW" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("FJ" & myvalue & ":GW" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("FJ" & myvalue & ":GW" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("FJ" & myvalue & ":GW" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("FJ" & myvalue & ":GW" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, _
254, 206)
.SetRange ActiveSheet.Range("FJ1:GW95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub
Sub Button6_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("GX:IK").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("GX" & myvalue & ":IK" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("GX" & myvalue & ":IK" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("GX" & myvalue & ":IK" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("GX" & myvalue & ":IK" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("GX" & myvalue & ":IK" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, _
254, 206)
.SetRange ActiveSheet.Range("GX1:GW95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub
I have this code that does a great job moving the data to the template and saving to the directory. Turned days worth of manual copy paste into a mere 15 minutes. Two issues I can not get to work. 1.Getting the buttons for sorting the periods to re-assign to the the new workbook, 2. using my hide empty columns macro to work. the reason I believe is because I just had the code to write our 40 columns of data regardless of how many students were in each period. I did this because the sort buttons are hard coded for those cell ranges. Any help is GREATLY appreciated. I am using Excel 2010.
Sub create_file()
Dim student_array(82, 39) As Variant
Dim eof_flag As String
Dim eoc_flag As String
Dim eot_flag As String
Dim t_name As String
Dim s_nbr As Long
Dim c_nbr As String
Dim per As Integer
Dim i As Integer
Dim j As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim j2 As Integer
Dim tchr_tab_row As Integer
Dim data_tab_col As Integer
Dim per_col As Integer
Dim max_row As Integer
eof_flag = "no"
eoc_flag = "no"
eot_flag = "no"
Dim FileName As Variant
Dim Campus As String
'
'get a teacher name
'
Worksheets("teacher tab").Select
teacher_tab_row = 1
'max_row has maximum number of rows on data tab
max_row = 82
c_nbr = Cells(teacher_tab_row, 1)
t_name = Cells(teacher_tab_row, 2)
Do While eof_flag <> "yes"
Worksheets("data tab").Select
i = 1
Worksheets("teacher tab").Select
Campus_Name = Cells(teacher_tab_row, 3)
File_Name = Cells(teacher_tab_row, 4)
Worksheets("data tab").Select
i = 1
'
' look for teacher in data tab
'
Do While eot_flag <> "yes"
If (((t_name = Cells(2, i)) And (c_nbr = Cells(4, i))) Or (Cells(2, i) = "")) Then
eot_flag = "yes"
Else
i = i + 1
End If
Loop
'
If Cells(2, i) <> "" Then
eot_flag = "found"
End If
'
'teacher has been found
'
data_tab_col = i
template_tab_col = 6
j2 = data_tab_col
per = Cells(3, j2)
Do While eot_flag = "found"
'
'zero out array to prepare for data
'
GoSub zero_out_array
'
'this is a nested loop for reading in the data from the data tab
'
For j = 1 To 39
'
'keep moving data into array as long as the teacher and the period and the campus is the same
' otherwise, jump out
'
If (Cells(2, j2) = t_name And Cells(4, j2) = c_nbr And Cells(3, j2) = per) Then
i2 = 1
For i = 1 To max_row
student_array(i, j) = Cells(i2, j2)
i2 = i2 + 1
Next
j2 = j2 + 1
Else
j = 40
End If
Next
'
'here is where we will move the data to the new sheet
'
Worksheets("template tab").Select
per_col = template_tab_col
For j = 1 To 39
i2 = 1
For i = 1 To max_row
Cells(i2, per_col) = student_array(i, j)
i2 = i2 + 1
Next
per_col = per_col + 1
Next
'
'if the teacher has another period, then switch to new period
'
Worksheets("data tab").Select
If Cells(2, j2) = t_name Then
per = Cells(3, j2)
template_tab_col = template_tab_col + 40
Else
eot_flag = "no"
End If
Loop
'
'get another teacher name
'
'this is where we will write out the template to finish off the teacher
Worksheets("template tab").Select
ActiveSheet.Copy
Dim Path As String
Campus = Campus_Name
Path = "Q:\ASSESSMENT\MIDDLE SCHOOLS\" & Campus & "\STUDENT PERFORMANCE TRACKERS\2016-2017\"
FileName = FileName_File_Name
ActiveWorkbook.SaveAs FileName:="Q:\ASSESSMENT\MIDDLE SCHOOLS\" & Campus & "\STUDENT PERFORMANCE TRACKERS\2016-2017\ " & File_Name & ".xlsm", FileFormat:=52
ActiveWorkbook.Close SaveChanges:=True
GoSub blank_template_sheet
'
GoSub search_tchr_tab
If eof_flag <> "yes" Then
eot_flag = "no"
End If
'
Loop
Exit Sub
search_tchr_tab:
Worksheets("teacher tab").Select
teacher_tab_row = teacher_tab_row + 1
c_nbr = Cells(teacher_tab_row, 1)
t_name = Cells(teacher_tab_row, 2)
If c_nbr = "" Then
eof_flag = "yes"
End If
Return
zero_out_array:
For j = 1 To 39
For i = 1 To max_row
student_array(i, j) = ""
Next
Next
Return
blank_template_sheet:
Worksheets("template tab").Select
Range("F1:AR100").ClearContents
Range("AT1:CF100").ClearContents
Range("CH1:DT100").ClearContents
Range("DV1:FH100").ClearContents
Range("FJ1:GV100").ClearContents
Range("GX1:IK100").ClearContents
Return
End Sub
Code for sorting this works fine, but wanted to share as this is the code connected to the buttons.16983
Sub Button1_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("F:AS").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("F" & myvalue & ":AS" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("F" & myvalue & ":AS" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("F" & myvalue & ":AS" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("F" & myvalue & ":AS" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("F" & myvalue & ":AS" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, _
254, 206)
.SetRange ActiveSheet.Range("F1:AS95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub
Sub Button2_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("AT:CG").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("AT" & myvalue & ":CG" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("AT" & myvalue & ":CG" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("AT" & myvalue & ":CG" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("AT" & myvalue & ":CG" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("AT" & myvalue & ":CG" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, _
254, 206)
.SetRange ActiveSheet.Range("AT1:CG95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub
Sub Button3_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("CH:DU").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("CH" & myvalue & ":DU" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("CH" & myvalue & ":DU" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("CH" & myvalue & ":DU" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("CH" & myvalue & ":DU" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("CH" & myvalue & ":DU" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, _
254, 206)
.SetRange ActiveSheet.Range("CH1:DU95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub
Sub Button4_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("DV:FI").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("DV" & myvalue & ":FI" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("DV" & myvalue & ":FI" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("DV" & myvalue & ":FI" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("DV" & myvalue & ":FI" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("DV" & myvalue & ":FI" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, 254, 206)
.SetRange ActiveSheet.Range("DV1:FI95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub
Sub Button5_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("FJ:GW").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("FJ" & myvalue & ":GW" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("FJ" & myvalue & ":GW" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("FJ" & myvalue & ":GW" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("FJ" & myvalue & ":GW" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("FJ" & myvalue & ":GW" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, _
254, 206)
.SetRange ActiveSheet.Range("FJ1:GW95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub
Sub Button6_Click()
Dim myvalue As Variant
'Dim myRng As Range
'
'Use an Input box to select the row to sort
myvalue = InputBox("Row Number")
ActiveSheet.Columns("GX:IK").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("GX" & myvalue & ":IK" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
199, 206)
ActiveSheet.Sort.SortFields.Add(Range("GX" & myvalue & ":IK" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 208, 59)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("GX" & myvalue & ":IK" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 147)
With ActiveSheet.Sort
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("GX" & myvalue & ":IK" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(220, _
230, 241)
'myvalue = InputBox("Row Number")
ActiveSheet.Sort.SortFields.Add(Range("GX" & myvalue & ":IK" & myvalue), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(206, _
254, 206)
.SetRange ActiveSheet.Range("GX1:GW95")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlSortRows
.Apply
End With
End Sub