lionheart

It is just one line of code and you can do it yourself. Refer to the desired range using Range property like that Range("A1:C10") Of course change the reference to the reference you need then use ClearContents method so the line should look like that Range("A1:C10").ClearContents The line will be added to the end of the code after trasnferring data before this line Application.Goto .Range("AM" & m), True Don't forget to change the reference A1 to C10 to the range you desire to clear its contents which should be F10:O & the last row (lr variable)

Try this code Sub Test() Dim ws As Worksheet, r As Long, lr As Long, i As Long, j As Long, m As Long Application.ScreenUpdating = False Set ws = Sheet1 ReDim a(1 To 1000, 1 To 17) With ws lr = .Cells(Rows.Count, "B").End(xlUp).Row For r = 10 To lr If Application.WorksheetFunction.CountBlank(.Range("E" & r).Resize(, 11)) <> 11 Then i = i + 1 For j = 2 To 18 a(i, j - 1) = .Cells(r, j).Value Next j End If Next r If i > 0 Then m = .Cells(Rows.Count, "AM").End(xlUp).Row + 1 m = IIf(m = 5, 9, m) .Range("AM" & m).Resize(i, UBound(a, 2)).Value = a Application.Goto .Range("AM" & m), True End If End With Application.ScreenUpdating = True MsgBox "Done", 64 End Sub

In cell D1 type the number 666 then in cell D4 put the formula ="Shatbeyya "&($D$1+5*(ROW()-4))&"-"&($D$1+4+5*(ROW()-4))

Try Private Sub CommandButton1_Click() Dim mySum As Double, i As Long With Me.ListBox1 For i = 0 To .ListCount - 1 mySum = mySum + Val(.List(i, 1)) Next i End With Me.TextBox1.Value = mySum End Sub

There a re alot of named ranges in Name Manager (Formulas Tab) Do you need them as they are related to worksheets not exist in your workbook If you are interested in breaking links you should get rid of such named ranges if they are not necessary for you

In worksheet module Private Sub Worksheet_Change(ByVal Target As Range) Dim v If Target.Address = "$B$2" Then v = Target.Value Rows("15:200").Hidden = False If v = 0 Then Rows("15:200").Hidden = True ElseIf v = Range("N67").Value Then Rows("51:200").Hidden = True ElseIf v = Range("N68").Value Then Rows("15:50").Hidden = True Rows("71:200").Hidden = True ElseIf v = Range("N69").Value Then Rows("15:70").Hidden = True Rows("151:200").Hidden = True ElseIf v = Range("N70").Value Then Rows("15:150").Hidden = True End If End If End Sub

Wait for someone to attach the file for you. I don't attach files You have to apply the steps by yourself. Sorry for that

Move the school logo as shown and rename it [School_Logo] 01 Modify the following parts in the code Sub kh_AutoFill(R As Integer) Dim SourceRange As Range, fillRange As Range, RR As Long, i As Long, j As Long RR = (R * CountRow) With MySheet Set SourceRange = .Rows(FirstRow).Resize(CountRow) Set fillRange = .Rows(FirstRow).Resize(RR) SourceRange.AutoFill fillRange, xlFillDefault For i = FirstRow To (FirstRow + RR - 1) Step CountRow j = (i - FirstRow) / CountRow + 1 .Shapes("School_Logo").Copy .Cells(i + 1, "O").PasteSpecial xlPasteAll .Shapes(.Shapes.Count).Name = "LH_Logo_" & j Next i .PageSetup.PrintArea = .Range("B" & FirstRow).Resize(RR, CountColumn).Address End With End Sub Also modify the following Sub Kh_Picture_Delete(MySh As Worksheet) On Error Resume Next Dim shp As Shape For Each shp In MySh.Shapes If shp.Name Like "KHK_*" Or shp.Name Like "LH_Logo_*" Then shp.Delete End If Next shp On Error GoTo 0 End Sub

Another solution Format the numbers on the worksheet with the following custom format [$-,201]0 then modify this line Controls("TextBox" & j).Text = Cells(ListBox1.List(i, 1), j).Text

In standard module Function ConvertToArabicNumber(ByVal num As String) As String Dim s As String, d As String, i As Long For i = 1 To Len(num) d = Mid(num, i, 1) s = s & ChrW(&H660 + Val(d)) Next i ConvertToArabicNumber = s End Function In the userform module modify the following procedure Private Sub ListBox1_Click() For i = 0 To ListBox1.ListCount If ListBox1.Selected(i) = True Then For j = 1 To 61 Controls("TextBox" & j).Text = ConvertToArabicNumber(Cells(ListBox1.List(i, 1), j)) Next j r = ListBox1.List(i, 1) Exit For End If Next i End Sub

this line will store any row that doesn't have the text .....If sh.Cells(r, "AN").Value <> Join(Array(C

Hope this help you Sub Test() Const SROW As Long = 7 ' Start row constant, set to row 7 Dim ws As Worksheet, sh As Worksheet, rng As Range, lr As Long, r As Long Application.ScreenUpdating = False ' Disable screen updating to improve performance With ThisWorkbook Set ws = .Worksheets(1): Set sh = .Worksheets(2) ' Set variables ws and sh to the first and second worksheets in the workbook, respectively End With sh.Rows(SROW & ":" & Rows.Count).Cells.Clear ' Clear all cells in rows from SROW to the last row in worksheet sh lr = ws.Cells(Rows.Count, "C").End(xlUp).Row ' Find the last used row in column C of worksheet ws If lr < SROW Then Exit Sub ' If the last used row is less than the start row, exit the subroutine ws.Range("A" & SROW & ":G" & lr).Copy sh.Range("A" & SROW) ' Copy the range from column A to G, starting from SROW to lr, from worksheet ws to worksheet sh ws.Range("AN" & SROW & ":AN" & lr).Copy sh.Range("AN" & SROW) ' Copy the range in column AN, starting from SROW to lr, from worksheet ws to worksheet sh For r = SROW To lr ' Loop through each row from SROW to lr If sh.Cells(r, "AN").Value <> Join(Array(Chr(207), Chr(230), Chr(209), Chr(32), Chr(203), Chr(199), Chr(228), Chr(237)), Empty) Then ' Check if the value in column AN of the current row in worksheet sh is not equal to the joined characters If rng Is Nothing Then Set rng = sh.Rows(r) Else Set rng = Union(rng, sh.Rows(r)) ' If rng is Nothing, set rng to the current row, otherwise, combine rng with the current row using the Union function End If Next r If Not rng Is Nothing Then rng.EntireRow.Delete ' If rng is not Nothing (i.e., there are rows to be deleted), delete the entire rows of rng lr = sh.Cells(Rows.Count, "C").End(xlUp).Row ' Find the last used row in column C of worksheet sh If lr < SROW Then Exit Sub ' If the last used row is less than the start row, exit the subroutine sh.Range("A" & SROW).Resize(lr - SROW + 1).Value = Evaluate("ROW(1:" & lr - SROW + 1 & ")") ' Populate the range starting from cell A7 to the last used row in column C of worksheet sh with the row numbers using the Evaluate function Application.ScreenUpdating = True ' Enable screen updating End Sub

Try this code. Copy the headers manually first. The code will put the results at row 7 as start point Sub Test() Const SROW As Long = 7 Dim ws As Worksheet, sh As Worksheet, rng As Range, lr As Long, r As Long Application.ScreenUpdating = False With ThisWorkbook Set ws = .Worksheets(1): Set sh = .Worksheets(2) End With sh.Rows(SROW & ":" & Rows.Count).Cells.Clear lr = ws.Cells(Rows.Count, "C").End(xlUp).Row If lr < SROW Then Exit Sub ws.Range("A" & SROW & ":G" & lr).Copy sh.Range("A" & SROW) ws.Range("AN" & SROW & ":AN" & lr).Copy sh.Range("AN" & SROW) For r = SROW To lr If sh.Cells(r, "AN").Value <> Join(Array(Chr(207), Chr(230), Chr(209), Chr(32), Chr(203), Chr(199), Chr(228), Chr(237)), Empty) Then If rng Is Nothing Then Set rng = sh.Rows(r) Else Set rng = Union(rng, sh.Rows(r)) End If Next r If Not rng Is Nothing Then rng.EntireRow.Delete lr = sh.Cells(Rows.Count, "C").End(xlUp).Row If lr < SROW Then Exit Sub sh.Range("A" & SROW).Resize(lr - SROW + 1).Value = Evaluate("ROW(1:" & lr - SROW + 1 & ")") Application.ScreenUpdating = True End Sub

In ThisWorkbook Module Private Sub Workbook_Open() Application.OnKey "{F9}", "TestMacro" End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.OnKey "{F9}" End Sub In Standard Module Sub TestMacro() Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("Qution") ws.Range("G17").Value = Empty: ws.Range("D17").Value = Empty With ws.Range("D17") .Formula = "=RANDBETWEEN(data1!A1,data1!A30)" .Value = .Value End With With Application .ScreenUpdating = True .EnableEvents = False .Calculation = xlCalculationManual .Wait Now + TimeValue("00:00:05") ws.Range("G17").Formula = "=LOOKUP(D17,data1!A1:A730,data1!F1:F30)" .Calculate .Calculation = xlCalculationAutomatic .EnableEvents = True End With End Sub

When you copy the code from the VBE to notepad, make sure the direction is for Arabic language, then copy the code to the notepad and you will find everything is OK

The desired output is still not clear. Generally try the following code and modify to suit your output Sub Test() Const SROW As Long = 15 Dim ws As Worksheet, rng As Range, iRow As Long, c As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.ActiveSheet With ws .Range("A" & SROW).CurrentRegion.Clear .Range("A1").CurrentRegion.Copy .Range("A" & SROW) Set rng = .Range("A" & SROW).CurrentRegion For iRow = SROW + 1 To rng.Rows.Count + SROW - 1 For c = 8 To 13 If .Cells(iRow, c).Value >= .Cells(iRow, "N").Value And .Cells(iRow, c).Value <= .Cells(iRow, "O").Value Then Else .Cells(iRow, c).ClearContents .Cells(iRow, c).Offset(, -6).ClearContents End If Next c Next iRow End With Application.ScreenUpdating = True End Sub

Attach an example file

Study the lines of the code well and if you didn't get any line tell me and I will tell you what to do exactly Do your best first

Try this code Sub ToggleButton_ON_OFF() Const ONKEY As String = "On", OFFKEY As String = "Off" Dim ws As Worksheet, shOnOff As Shape, shToggle As Shape, shRadio As Shape, s As String Set ws = ActiveSheet With ws Set shOnOff = .Shapes("txtboxOnOff") Set shToggle = .Shapes("ToggleButton1") Set shRadio = .Shapes("radioButton") End With With shOnOff s = .TextFrame.Characters.Text .TextFrame.Characters.Text = IIf(s = ONKEY, OFFKEY, ONKEY) ws.Rows("12").Hidden = (s = OFFKEY) .TextFrame.HorizontalAlignment = IIf(s = ONKEY, xlHAlignLeft, xlHAlignRight) shToggle.Fill.ForeColor.RGB = IIf(s = ONKEY, RGB(232, 27, 34), RGB(117, 199, 1)) shRadio.Left = shToggle.Left + IIf(s = ONKEY, shToggle.Width - shRadio.Width - 5, 5) End With End Sub

VBA codes are better than using formulas Formulas will make the file slower and bigger in size

Use this code Sub DropDownSelection() Dim v, x, ws As Worksheet, myDrop As DropDown Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("1") Set myDrop = ActiveSheet.DropDowns("myDropDown") v = myDrop.List(myDrop.Value) x = Application.Match(v, ws.Columns(3), 0) If Not IsError(x) Then With ActiveSheet .Range("C9").Value = ws.Cells(x, 3).Value .Range("J9").Value = ws.Cells(x, 4).Value 'complete by yourself End With End If Application.ScreenUpdating = True End Sub Assign macro to the drop down by right-click on the drop down and select Assign Macro and select the macro name [DropDownSelection]

I am so sorry but I will not be available till tomorrow Hope someone else will help you May Allah bless you

I don't like attaching files But I see there is a huge mess Click Down arrow first then use Up arrow File.xlsb

The code I provided is just to fill the drop down form button with the names related to specific grade