lionheart

You can use helper columns A & B to achieve what you need by formulas مباريات.xlsx

After this line s = s & IIf(s = vbNullString, vbNullString, vbLf) & x.Name refer to the desire target cell by using the r variable like that Cells(r + 4, "H").Value = x.Name

No attachment, no code so no help

Use CHAR(10) instead of the space

I didn't get what you mean Show me the desired result

Yes you can show the result in any cell by using the cell reference like that Range("H4").Value = r

What about PDF as output

Private Sub CommandButton4_Click() Dim x As Control, s As String, r As Long For Each x In UserForm2.Controls If TypeName(x) = "CheckBox" Then If x.Value = True Then r = r + 1 s = s & IIf(s = vbNullString, vbNullString, vbLf) & x.Name End If End If Next x MsgBox "There are " & r & " Checkboxes" & vbCrLf & s End Sub

The output will be printed or what? Can you explain what will you do with the final output

Private Sub CommandButton1_Click() ActiveCell.FormulaR1C1 = "10" ActiveCell.Offset(1, 0).Select End Sub Private Sub CommandButton2_Click() ActiveCell.Value = Val(ActiveCell.Offset(-1, 0).Value) + 50 ActiveCell.Offset(1, 0).Select End Sub

Post a new question in new thread

I will leave the explanation of the code to someone who can understand vba codes as I will not be able to explain in Arabic

learning is a continuous process and we were not born know anything. Try and you will be able to do it yourself

I just gave you some instructions. Now you have the main code, study it well then try to implement your needs in the code

I can't help you anymore as there are no clear steps But generally you can use IF statement and the property NAME to refer to sepcific worksheet If worksheets(i).Name = "NAMEOFSHEET" Then 'Do Something Else 'Do Another Thing End If

Not clear for me. I will leave this question for those who are specialist in accounting

In cell S3 you can use this formula instead of hard-coding the formula in that terrible way =IFERROR(INDEX(XEX:XEX,MATCH(R3,XEY:XEY,0)),"")

Before the loop in the code use this line Me.ListBox1.Clear

Change the variable i to determine the worksheets index number to suit your needs

There are not enought details but try the following code study it well and change it to suit your needs Option Explicit Private Sub ComboBox1_Change() Dim ws As Worksheet, i As Integer, m As Long, r As Long, k As Long For i = 2 To 5 Set ws = ThisWorkbook.Worksheets(i) With ws m = .Cells(Rows.Count, "D").End(xlUp).Row If m <= 1 Then GoTo NXT For r = 2 To m If .Cells(r, "D").Value = ComboBox1.Value Then With Me.ListBox1 If k = 0 Then .ColumnCount = 3 .AddItem .List(k, 0) = ws.Cells(r, 1).Value .List(k, 1) = ws.Cells(r, 2).Value .List(k, 2) = ws.Cells(r, 6).Value k = k + 1 End With End If Next r NXT: End With Next i End Sub

It seems you are using Windows 32Bit so remove the word PtrSafe from the first line that appears in red color

Sub Test() Const sOut As String = "Output" Dim a(1 To 10000, 1 To 4), ws As Worksheet, sh As Worksheet, m As Long, r As Long, k As Long Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next: Sheets(sOut).Delete: On Error GoTo 0 Application.DisplayAlerts = True For Each ws In ThisWorkbook.Worksheets m = ws.Cells(Rows.Count, "V").End(xlUp).Row For r = 21 To m If Trim(ws.Cells(r, "Q").Value) = "HEALTHY" Then k = k + 1 a(k, 1) = ws.Cells(r, "R").Value a(k, 2) = ws.Cells(r, "P").Value a(k, 3) = ws.Range("C6").Value a(k, 4) = ws.Range("B14").Value End If Next r Next ws If k > 0 Then Sheets.Add , Sheets(Sheets.Count) ActiveSheet.Name = sOut With Sheets(sOut) .Range("A1").Resize(, 4).Value = Array("Names", "Date", "Grade", "Class") .Range("A2").Resize(UBound(a, 1), UBound(a, 2)).Value = a .DisplayRightToLeft = True .Columns.AutoFit End With Else MsgBox "No Data", vbExclamation: Exit Sub End If Application.ScreenUpdating = True End Sub Please learn how to click on the LIKE button

In standard module put the code Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Play, sMusicFile As String Sub Play_MP3_File() PlaySound ThisWorkbook.Path & "\YOURFILE.mp3" End Sub Public Sub PlaySound(ByVal File$) Dim sPath As String, sFileName As String sMusicFile = File Play = mciSendString("play " & sMusicFile, 0&, 0, 0) If Play <> 0 Then sPath = CurDir If InStr(sMusicFile, ":") > 0 Then ChDrive (Left(sMusicFile, 1)) If InStr(sMusicFile, "\") > 0 Then ChDir (Left(sMusicFile, InStrRev(sMusicFile, "\") - 1)) sFileName = Mid(sMusicFile, InStrRev(sMusicFile, "\") + 1) If InStr(sFileName, " ") > 0 Then FileCopy sFileName, Replace(sFileName, " ", "") sMusicFile = Left(sMusicFile, InStrRev(sMusicFile, "\")) & Replace(sFileName, " ", "") Play = mciSendString("play " & Replace(sFileName, " ", ""), 0&, 0, 0) Else Play = mciSendString("play " & sFileName, 0&, 0, 0) End If Else sFileName = Replace(sMusicFile, " ", "") If sMusicFile <> sFileName Then FileCopy sMusicFile, sFileName: sMusicFile = sFileName Play = mciSendString("play " & sMusicFile, 0&, 0, 0) End If ChDrive (Left(sPath, 1)) ChDir (Left(sPath, InStrRev(sPath, "\") - 1)) End If End Sub Public Sub StopSound(Optional ByVal FullFile$) Play = mciSendString("close " & sMusicFile, 0&, 0, 0) End Sub Then in ThisWorkbook module put the code Private Sub Workbook_Open() Call Play_MP3_File End Sub

Please upload a sample file of the expected output that you need exactly

To implement With your workbook active press Alt+F11 to bring up the vba window In the Visual Basic window use the menu to Insert|Module Copy and Paste the code below into the main right hand pane that opens at step 2 Close the Visual Basic window Press Alt+F8 to bring up the Macro dialog Select the macro & click Run Your workbook will need to be saved as a macro-enabled workbook (*.xlsm)