lionheart

Sub Test() Dim Last As Long, i As Long Last = Sheet4.Range("A100000").End(xlUp).Row + 1 For i = 1 To 7 Sheet4.Cells(Last, i).Value = Me.Controls("TextBox" & i + 1).Value Next i End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim sh As Long, v As Long, r As Long, lr As Long, i As Long, ii As Long If Target.Address = "$Q$4" Then Application.ScreenUpdating = False Application.EnableEvents = False Range("A10:T60000") = "" sh = Worksheets.Count: v = 10 For r = 1 To sh If Sheets(r).Name <> ActiveSheet.Name Then lr = Sheets(r).Range("i" & Rows.Count).End(xlUp).Row For i = 10 To lr If Range("Q4") = Sheets(r).Cells(i, 9) Then Cells(v, 1).Resize(, 20).Value = Sheets(r).Cells(i, 1).Resize(, 20).Value v = v + 1 End If Next i End If Next r Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub

Try to increase the variable m by two instead of 1 to be like that m = m + 2

Sub Test() Dim ws As Worksheet, sh As Worksheet, r As Long, m As Long, n As Long Application.ScreenUpdating = False Set ws = Sheet1: Set sh = Sheet4 m = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 n = m For r = 5 To ws.Cells(Rows.Count, 1).End(xlUp).Row If ws.Cells(r, 1).Value <> "" And ws.Cells(r, 1).Value <> ws.Range("A4").Value Then sh.Cells(m, 1).Resize(, 12).Value = ws.Cells(r, 1).Resize(, 12).Value m = m + 1 End If Next r sh.Range("A" & n - 2 & ":L" & n - 1).Copy sh.Range("A" & n & ":L" & m - 1).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

Sub Rename_Worksheets() Dim i As Long For i = 1 To Sheets.Count If Worksheets(i).Name <> "Sheet2" And Worksheets(i).Name <> "Sheet4" Then If Worksheets(i).Range("N14").Value <> "" Then Sheets(i).Name = Worksheets(i).Range("n14").Value End If End If Next i End Sub

Replace "Sales Bill" in th code with the Arabic characters Sub Test() Dim x, ws As Worksheet, sh As Worksheet, r As Long, lr As Long Set ws = Sheet5: Set sh = Sheet8 For r = 5 To ws.Cells(Rows.Count, "G").End(xlUp).Row If ws.Cells(r, 7).Value = "Sales Bill" Then ws.Cells(r, 11).Value = "Sales Bill" Else x = Application.Match(ws.Cells(r, 8).Value, sh.Columns(3), 0) If Not IsError(x) Then ws.Cells(r, 11).Value = sh.Cells(x, 4).Value End If End If Next r End Sub

In worksheet module put the following code Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 2 And (Target.Column = 5 Or Target.Column = 6) Then Application.EnableEvents = False Target.Value = Target.Value / 24 Application.EnableEvents = True Target.NumberFormat = "hh:mm" End If End Sub

Press Alt + F11 to login VBE editor From Insert menu select Module Paste the code Back to the worksheet and press Alt + F8 and click Run th execute the code

Sub Test() Dim r As Long, m As Long Application.ScreenUpdating = False r = 1: m = 7 Do Cells(m, 4).Resize(, 6).Value = Application.Transpose(Cells(r, 1).Resize(6).Value) m = m + 1: r = r + 6 Loop Until r >= Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = True End Sub

The question is not related to the main question Anyway this line will print the activesheet ActiveSheet.PrintOut You asked for a fomula to print (that is too weird) Generally you can press Ctrl + P to print without any formulas or codes

Try using semi-colon instead of comma like that ;

In Data tab select data validation and select Custom and finally insert a formula like that =OR((A1="A"),AND(A1>=0,A1<=70)) Change the A letter with the absent character in arabic

First unprotect the worksheet Select cell B8 which is related to the scroll bar form control > Right-click the cell > Format Cells > Protection tab > Uncheck the Locked option Finally protect the worksheet again

You can directly use this line if you don't care about empty items MsgBox ListBox1.ListCount

Private Sub UserForm_Initialize() ListBox1.List = Range("A2:C11").Value End Sub Private Sub CommandButton1_Click() Dim c As Integer, i As Integer, t As Double Rem First Column In ListBox = 0 c = 0 For i = 0 To ListBox1.ListCount - 1 If ListBox1.List(i, c) <> Empty Then t = t + 1 Next i MsgBox t End Sub

You can change number 1 in this line with 3 .Range("A3").Resize(x, 1) = temp

Insert a module and paste the following UDF Function AutoSum(rng As Range) As Variant Dim ws As Worksheet AutoSum = 0 Application.Volatile True For Each ws In Worksheets If Not ws Is Application.ThisCell.Parent Then AutoSum = AutoSum + ws.Range(rng.Address) End If Next ws End Function Then in Total worksheet you can use the formula like that (example in cell A9 put the formula) =AutoSum(A9)

The code will work only if you change any cell in column T manually and the code will not be triggered when copying more than one cell Try deleting the first line in the code

The code is put in worksheet module not in standard module Right-click worksheet name and select [View Code] then paste the code I posted

In worksheet module Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 2 And Target.Column = 20 Then Application.Goto Cells(Target.Row + 1, 2) End If End Sub

Replace this line Range("a10:u" & Cells(Rows.Count, "u").End(xlUp).Row).Copy With this line Range("a10:u21").Copy

You can click on LIKE button if the code solved your problem

In worksheet module Private Sub Worksheet_Change(ByVal Target As Range) Dim x If Target.Address = "$A$1" Then Columns("B:AT").Hidden = False If Target.Value = Empty Then Target.Select: Exit Sub x = Application.Match(Target.Value2, Rows(3), 0) If Not IsError(x) Then Columns("B:AT").Hidden = True Columns(x).Hidden = False End If Target.Select End If End Sub

Sub Test() Dim a, temp, dict As Object, buy As Double, sell As Double, i As Long, x As Long Set dict = CreateObject("Scripting.Dictionary") With Sheets("Sheet1").Cells(2).CurrentRegion a = .Value: ReDim temp(1 To UBound(a), 1 To 3) For i = 2 To UBound(a) If Not dict.Exists(a(i, 1)) Then dict.Add a(i, 1), "" buy = Application.WorksheetFunction.SumIfs(.Columns(7), .Columns(1), a(i, 1), .Columns(2), "BUY") sell = Application.WorksheetFunction.SumIfs(.Columns(7), .Columns(1), a(i, 1), .Columns(2), "SELL") If buy > sell Then x = x + 1: temp(x, 1) = a(i, 1): temp(x, 2) = buy: temp(x, 3) = sell End If Next i End With With Sheets("Sheet2") .Columns(1).ClearContents .Range("A2").Value = "Market" .Range("A3").Resize(x, 1) = temp End With End Sub

It is supposed that it prints each certificate just once not twice