lionheart

You didn't explain the problem well. Please be sepcific and put the desired output as an image if you wait more help Private Sub btnOk_Click() Dim x As Control, s As String, r As Long Range("H1:H30").Clear 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 Cells(r + 4, "H").Value = x.Caption End If End If Next x Range("H4").Value = r End Sub

I have no idea. Attach your file

Sub Test() Dim w, d As Object, r As Range Set d = CreateObject("Scripting.Dictionary") d.CompareMode = 1 With Range("A2", Range("A" & Rows.Count).End(xlUp)) .Interior.colorIndex = xlNone For Each r In .Cells If Not d.Exists(r.Value) Then ReDim w(1 To 2) Set w(1) = r With Application.WorksheetFunction w(2) = Array(.RandBetween(0, 255), .RandBetween(0, 255), .RandBetween(0, 255)) End With d(r.Value) = w Else w = d(r.Value) r.Interior.Color = RGB(w(2)(0), w(2)(1), w(2)(2)) If Not IsEmpty(d(r.Value)(1)) Then d(r.Value)(1).Interior.Color = RGB(w(2)(0), w(2)(1), w(2)(2)) w(1) = Empty d(r.Value) = w End If Next r End With End Sub

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