• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How can I do this macro do for other pages also

A

avnitoto

New Member
How can I do this macro do for other pages also it is ok for first page

Private Sub CommandButton1_Click()
tm = Cells(60000, 1).End(xlUp).Row
For i = 2 To tm
s = 0
For Each x In Range(Cells(1, 1), Cells(1, 22))
For Each y In Range(Cells(i, 1), Cells(i, 22))
If x = y Then
s = s + 1
y.Font.ColorIndex = 3
End If
Next y, x
Cells(i, 24) = s
Next i

End Sub
 

Attachments

  • How to do also for other pagess.rar
    43.2 KB · Views: 9
you want to apply the same macro for each worksheets?
Try this .

Code: 
Private Sub CommandButton1_Click()
dim ws as worksheets
tm = Cells(60000, 1).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
For i = 2 To tm
s = 0
For Each x In Range(Cells(1, 1), Cells(1, 22))
For Each y In Range(Cells(i, 1), Cells(i, 22))
If x = y Then
s = s + 1
y.Font.ColorIndex = 3
End If
Next y, x
Cells(i, 24) = s
Next i
Next ws
End Sub
 
Last edited by a moderator:
ANKUSHRS1 said:
you want to apply the same macro for each worksheets?
Try this .

Code: 
Private Sub CommandButton1_Click()
dim ws as worksheets
tm = Cells(60000, 1).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
For i = 2 To tm
s = 0
For Each x In Range(Cells(1, 1), Cells(1, 22))
For Each y In Range(Cells(i, 1), Cells(i, 22))
If x = y Then
s = s + 1
y.Font.ColorIndex = 3
End If
Next y, x
Cells(i, 24) = s
Next i
Next ws
End Sub
Click to expand...

Thanks for your help
Yes I Want to apply the same macro for each worksheets
but I debug your code it gives error screen at the attach file

(For Each ws In ThisWorkbook.Worksheets) error

I am not good at in vba
Thanks
 

Attachments

  • error.jpg
    error.jpg
    211.6 KB · Views: 3
try this
Code: 
Private Sub CommandButton1_Click()

tm = Cells(60000, 1).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
ws.Activate
For i = 2 To tm
s = 0
For Each x In Range(Cells(1, 1), Cells(1, 22))
For Each y In Range(Cells(i, 1), Cells(i, 22))
If x = y Then
s = s + 1
y.Font.ColorIndex = 3
End If
Next y, x
Cells(i, 24) = s
Next i
Next ws
End Sub
 
ANKUSHRS1 said:
try this
Code: 
Private Sub CommandButton1_Click()

tm = Cells(60000, 1).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
ws.Activate
For i = 2 To tm
s = 0
For Each x In Range(Cells(1, 1), Cells(1, 22))
For Each y In Range(Cells(i, 1), Cells(i, 22))
If x = y Then
s = s + 1
y.Font.ColorIndex = 3
End If
Next y, x
Cells(i, 24) = s
Next i
Next ws
End Sub
Click to expand...


No
It gives just first worksheets again
 
Try:
Code: 
Private Sub CommandButton1_Click()
For Each ws In ThisWorkbook.Worksheets
  tm = ws.Cells(60000, 1).End(xlUp).Row
  For i = 2 To tm
    s = 0
    For Each x In Range(ws.Cells(1, 1), ws.Cells(1, 22))
      For Each y In Range(ws.Cells(i, 1), ws.Cells(i, 22))
        If x = y Then
          s = s + 1
          y.Font.ColorIndex = 3
        End If
      Next y, x
      ws.Cells(i, 24) = s
    Next i
  Next ws
End Sub
 
The first worksheet is the only one with something on the first row.

If you want all sheets to use this worksheet's row 1 then:
Code: 
Private Sub CommandButton1_Click()
For Each ws In ThisWorkbook.Worksheets
  tm = ws.Cells(60000, 1).End(xlUp).Row
  For i = 2 To tm
    s = 0
    'For Each x In Range(ws.Cells(1, 1), ws.Cells(1, 22))
    For Each x In Range(Sheets("Page1").Cells(1, 1), Sheets("Page1").Cells(1, 22))
      For Each y In Range(ws.Cells(i, 1), ws.Cells(i, 22))
        If x = y Then
          s = s + 1
          y.Font.ColorIndex = 3
        End If
      Next y, x
      ws.Cells(i, 24) = s
    Next i
  Next ws
End Sub
 
p45cal said:
The first worksheet is the only one with something on the first row.

If you want all sheets to use this worksheet's row 1 then:
Code: 
Private Sub CommandButton1_Click()
For Each ws In ThisWorkbook.Worksheets
  tm = ws.Cells(60000, 1).End(xlUp).Row
  For i = 2 To tm
    s = 0
    'For Each x In Range(ws.Cells(1, 1), ws.Cells(1, 22))
    For Each x In Range(Sheets("Page1").Cells(1, 1), Sheets("Page1").Cells(1, 22))
      For Each y In Range(ws.Cells(i, 1), ws.Cells(i, 22))
        If x = y Then
          s = s + 1
          y.Font.ColorIndex = 3
        End If
      Next y, x
      ws.Cells(i, 24) = s
    Next i
  Next ws
End Sub
Click to expand...


THANKS VERY MUCH IT OK
ALSO Is It posible to write how many 0 1 2 3 4 5 6 7 8 9 and 10 in X column as I did Z5:AJ5 manualy for all worksheet to count
QUESTION IS IN ATTACHED FILE ALSO
 

Attachments

  • Count how many.xlsm
    106.2 KB · Views: 2
Last edited:
Code: 
Private Sub CommandButton1_Click()
Dim HowMany(1 To 2, 0 To 10) As Long
For i = LBound(HowMany, 2) To UBound(HowMany, 2)
  HowMany(1, i) = UBound(HowMany, 2) - i
Next i
For Each ws In ThisWorkbook.Worksheets
  tm = ws.Cells(60000, 1).End(xlUp).Row
  For i = 2 To tm
    s = 0
    'For Each x In Range(ws.Cells(1, 1), ws.Cells(1, 22))
    For Each x In Range(Sheets("Page1").Cells(1, 1), Sheets("Page1").Cells(1, 22))
      For Each y In Range(ws.Cells(i, 1), ws.Cells(i, 22))
        If x = y Then
          s = s + 1
          y.Font.ColorIndex = 3
        End If
      Next y, x
      ws.Cells(i, 24) = s
      HowMany(2, UBound(HowMany, 2) - s) = HowMany(2, UBound(HowMany, 2) - s) + 1
    Next i
  Next ws
  Sheets("Page1").Range("Z4").Resize(2, UBound(HowMany, 2) + 1) = HowMany
End Sub
 
p45cal said:
Code: 
Private Sub CommandButton1_Click()
Dim HowMany(1 To 2, 0 To 10) As Long
For i = LBound(HowMany, 2) To UBound(HowMany, 2)
  HowMany(1, i) = UBound(HowMany, 2) - i
Next i
For Each ws In ThisWorkbook.Worksheets
  tm = ws.Cells(60000, 1).End(xlUp).Row
  For i = 2 To tm
    s = 0
    'For Each x In Range(ws.Cells(1, 1), ws.Cells(1, 22))
    For Each x In Range(Sheets("Page1").Cells(1, 1), Sheets("Page1").Cells(1, 22))
      For Each y In Range(ws.Cells(i, 1), ws.Cells(i, 22))
        If x = y Then
          s = s + 1
          y.Font.ColorIndex = 3
        End If
      Next y, x
      ws.Cells(i, 24) = s
      HowMany(2, UBound(HowMany, 2) - s) = HowMany(2, UBound(HowMany, 2) - s) + 1
    Next i
  Next ws
  Sheets("Page1").Range("Z4").Resize(2, UBound(HowMany, 2) + 1) = HowMany
End Sub
Click to expand...


THANK YOU VERY MUCH YOU ARE THE BEST
 
You must log in or register to reply here.
Back
Top