Snasui Excel Forum

Code: Select all

Sub ClsOverScore2()
    Dim lastRow As Long
    Dim i As Long, r As Range, j As Long
    
    With Worksheets("ไทย")
        Set r = .Range("D6")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
            j = r.Offset(i, 0).Row
        Loop
        lastRow = .Range("D" & .Rows.Count).End(xlUp).Row
        .Range("E" & j, .Range("R" & lastRow)).ClearContents
        .Range("T" & j, .Range("U" & lastRow)).ClearContents
        .Range("Y" & j, .Range("AL" & lastRow)).ClearContents
        .Range("AN" & j, .Range("AO" & lastRow)).ClearContents
End With
End Sub

Code: Select all

Sub ClsOverScore2()
    Dim lastRow As Long
    Dim i As Long, r As Range, j As Long
    
    With Worksheets("ä·Â")
        Set r = .Range("D6")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
            j = r.Offset(i, 0).Row
        Loop
        lastRow = .Range("e" & .Rows.Count).End(xlUp).Row
        .Range("d" & j, .Range("r" & lastRow)).ClearContents
        .Range("y" & j, .Range("al" & lastRow)).ClearContents
        .Range("an" & j, .Range("ao" & lastRow)).ClearContents
    End With
End Sub

Code: Select all

Sub ClsOverScore2()
    Dim lastRow As Long
    Dim i As Long, r As Range, j As Long
    
      With Worksheets("ไทย")
        Set r = .Range("D6")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
    .Range(r.Offset(i, 1), .Range("R" & .Rows.Count).End(xlUp)).ClearContents
        End With
        
      With Worksheets("ไทย")
        Set r = .Range("S6")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
        .Range(r.Offset(i, 1), .Range("U" & .Rows.Count).End(xlUp)).ClearContents
        End With
        
          With Worksheets("ไทย")
        Set r = .Range("X6")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
                        .Range(r.Offset(i, 1), .Range("AL" & .Rows.Count).End(xlUp)).ClearContents
        End With
        
        With Worksheets("ไทย")
        Set r = .Range("AM6")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
                        .Range(r.Offset(i, 1), .Range("AO" & .Rows.Count).End(xlUp)).ClearContents
        End With
        
End Sub

Code: Select all

Sub ClsOverScore()
    Dim lastRow As Long
    Dim i As Long, r As Range, j As Long
    
    With Worksheets("EvaAttib")
        Set r = .Range("D6")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
    .Range(r.Offset(i, 1), .Range("H" & .Rows.Count).End(xlUp)).ClearContents
        End With
    With Worksheets("EvaAttib")
        Set r = .Range("I6")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
                        .Range(r.Offset(i, 1), .Range("M" & .Rows.Count).End(xlUp)).ClearContents
        End With
            With Worksheets("EvaAttib")
        Set r = .Range("N6")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
                        .Range(r.Offset(i, 1), .Range("O" & .Rows.Count).End(xlUp)).ClearContents
        End With
        
End Sub

Code: Select all

Dim sh As Worksheet, r As Range, l As Integer
For Each sh In Worksheets
    If sh.Range("b1").MergeCells Then
        With sh
            l = Application.CountIfs(.Range("d6:d100"), "?*")
            For Each r In .Range("d" & l + 6, "as51")
                If Not r.Locked Then
                    r.ClearContents
                End If
            Next r
        End With
    End If
Next sh

Code: Select all

Sub cls()
Dim sh As Worksheet, l&
l = Application.Max(Sheets("Student").[B:B])
For Each sh In ThisWorkbook.Sheets
    If sh.[b6] = 1 Then
        sh.Unprotect
        sh.Range(Replace("F#:S58,U#:V58,Z#:AM58,AO#:AP58", "#", l + 6)).ClearContents
        sh.Protect
    End If
Next
End Sub

Code: Select all

Dim sh As Worksheet, r As Range, l As Integer
For Each sh In Worksheets
    If sh.Range("b1").MergeCells Then
        With sh
            l = Application.CountIfs(.Range("d6:d100"), "?*")
            For Each r In .Range("d" & l + 6, "as51")
                If Not r.Locked Then
                    r.ClearContents
                End If
            Next r
        End With
    End If
Next sh

Code: Select all

Sub cls()
Dim sh, l&
For Each sh In Array("Thai", "Eng", "Pysical", "Sci", "Social", "Techno")
    With Sheets(sh)
        l = .[D6].End(xlDown).Row + 1
        .Range(Replace("F#:S999,U#:V999,Z#:AM999,AO#:AP999", "#", l)).ClearContents
    End With
Next
End Sub

Code: Select all

Sub cls()
Dim sh, l&
For Each sh In Array("Thai", "Eng", "Pysical", "Sci", "Social", "Techno")
    With Sheets(sh)
        l = .[D6].End(xlDown).Row + 1
        .Range(Replace("F#:S999,U#:V999,Z#:AM999,AO#:AP999", "#", l)).ClearContents
    End With
Next
End Sub

Code: Select all

Sub cls()
Dim sh As Worksheet, l&
For Each sh In ThisWorkbook.Sheets
   l = sh.[D6].End(xlDown).Row + 1
    sh.Range(Replace("F#:S50,U#:V50,Z#:AM50,AO#:AP50", "#", l)).ClearContents
Next
End Sub

Code: Select all

Sub cls()
Dim sh As Worksheet, l&
For Each sh In ThisWorkbook.Sheets
   l = sh.[D6].End(xlDown).Row + 1
    sh.Range(Replace("F#:S50,U#:V50,Z#:AM50,AO#:AP50", "#", l)).ClearContents
Next
End Sub

Code: Select all

Sub clsScore()
    Dim lastRow As Long
    Dim i As Long, r As Range
    With Worksheets("thai")
        lastRow = .Cells(.Rows.Count, 44).End(xlUp).Row
    lastRow = .Cells(.Rows.Count, 17).End(xlUp).Row
    For i = 6 To lastRow
    If .Cells(i, 2) = "" Then
     .Cells(i, 6).Resize(, 14).ClearContents
     .Cells(i, 21).Resize(, 2).ClearContents
   .Cells(i, 26).Resize(, 14).ClearContents
      .Cells(i, 41).Resize(, 2).ClearContents
     End If
    Next i
    End With
    With Worksheets("Eng")
    lastRow = .Cells(.Rows.Count, 44).End(xlUp).Row
    lastRow = .Cells(.Rows.Count, 17).End(xlUp).Row
    For i = 6 To lastRow
    If .Cells(i, 2) = "" Then
     .Cells(i, 6).Resize(, 14).ClearContents
     .Cells(i, 21).Resize(, 2).ClearContents
   .Cells(i, 26).Resize(, 14).ClearContents
      .Cells(i, 41).Resize(, 2).ClearContents
     End If
    Next i
    End With
    With Worksheets("pysical")
'    With Worksheets.Sheet3
    lastRow = .Cells(.Rows.Count, 44).End(xlUp).Row
    lastRow = .Cells(.Rows.Count, 17).End(xlUp).Row
    For i = 6 To lastRow
    If .Cells(i, 2) = "" Then
     .Cells(i, 6).Resize(, 14).ClearContents
     .Cells(i, 21).Resize(, 2).ClearContents
   .Cells(i, 26).Resize(, 14).ClearContents
      .Cells(i, 41).Resize(, 2).ClearContents
     End If
    Next i
    End With
      With Worksheets("sci")
'    With Worksheets.Sheet3
    lastRow = .Cells(.Rows.Count, 44).End(xlUp).Row
    lastRow = .Cells(.Rows.Count, 17).End(xlUp).Row
    For i = 6 To lastRow
    If .Cells(i, 2) = "" Then
     .Cells(i, 6).Resize(, 14).ClearContents
     .Cells(i, 21).Resize(, 2).ClearContents
   .Cells(i, 26).Resize(, 14).ClearContents
      .Cells(i, 41).Resize(, 2).ClearContents
     End If
    Next i
    End With
End Sub

Code: Select all

Sub clsScore()
    Dim lastRow As Long
    Dim i As Long, r As Range
    With Worksheets("Page1")
    lastRow = .Cells(.Rows.Count, 17).End(xlUp).Row
    For i = 2 To lastRow
    If .Cells(i, 1) = "" Then
     .Cells(i, 2).Resize(, 15).ClearContents
     End If
    Next i
    End With
End Sub

Code: Select all

Sub clsScore()
    Dim lastRow As Long
    Dim i As Long, r As Range
    With Worksheets("Page1")
    Range("A2").Select
        Set r = .Range("A2")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
          lastRow = r.Offset(i - 1, 0).Row
        If Selection.Row <= lastRow Then
'        Range(lastRow).Select
         Range("C9:P12").Select
'         Selection.ClearContents
        End If
        End With
End Sub