VBA to count the number of entry in a row and update in count column

[swindel]

Hello,

I am new in this forum and would like to understand the VBA macro, Just wanna know how can I count the number of entries in a row per criteria. I have the Unique ID, and have a couple of data and will insert the count on Count Y and Count X.

ID	Data 1	Data 2	Data 3	Data 4	Data 5	Data 6	Count Y	Count X
1​	X	Y	X	X	X		1​	4​
2​	X	X		X			0​	3​
3​		Y	Y	Y			3​	0​
4​	Y	Y	Y	X		X	2​	2​
5​							0​	0​
6​	X		X	Y	Y		1​	2​
7​		Y	Y	Y	X	X	3​	2​

 

[Micron]

No, I mean outer loop moves through records, inner loop moves through fields. When all of the fields have been 'looked at' that inner loop is finished, thus it passes control to the outer loop which moves to the next record. Inner loop (field loop) runs again. This repeats until all the records (outer loop) have been accessed.

 

[swindel]

Hi Micron,

Can you guide me how to do it. Will i use this set?

Do Until rs.EOF
For Each .Fields
Counter = Counter + 1

 

[Micron]

Try this untested code. Substitute your table/query name where indicated.

Sub Countxy()
Dim rs As DAO.Recordset, fld As Field
Dim intX As Integer, intY As Integer

Set rs = CurrentDb.OpenRecordset("tblMyTableNameHere")
If Not (rs.BOF and rs.EOF) Then
  Do While Not rs.EOF
    rs.MoveFirst
    For each fld in rs.Fields
      If rs.fld = "X" Then intX = intX + 1
      If rs.fld = "Y" Then intY = intY + 1
    Next
    rs.Fields("CountX") = intX
    rs.Fields("CountY") = intY
    rs.MoveNext
  Loop
End If

Set rs = Nothing

End Sub

 

[swindel]

HI Micron,

Thank you, will try it later.

 

[james_lankford]

I think you need to move the
rs.MoveFirst
up one line

 

[Micron]

Nice catch! Possible to edit that code or would I have to re-post another version of untested code? I'd hate for anyone to just stop there and copy that. They'll end up in a never ending loop.

 

[swindel]

Hello Micron,

Sure i will, is just that I still don't have the time to tested it at the moment. I will this week. Thank you very much.

 

[swindel]

Hello Micron,

Apologize, i just tested it now cause i just finished my project.. There is an error with this field.
If rs.fld = "X" Then intX = intX + 1
If rs.fld = "Y" Then intY = intY + 1

and when i changed it to rs.Name the error focus on this.

rs.Fields("CountX") = intX
rs.Fields("CountY") = intY

 

[Micron]

Try this - limited testing but it worked (change Sheet1 to the name of your table). If there is no x or y, I assumed you didn't want 0 to be written to the count fields but upon reviewing earlier post I think you might want a zero. I can fix that if required.
NOTE: you seem to be storing a calculation in a table and that is usually not advised.

Sub Countxy()
Dim rs As DAO.Recordset
Dim intX As Integer, intY As Integer, i As Integer

Set rs = CurrentDb.OpenRecordset("sheet1")
If Not (rs.BOF And rs.EOF) Then
   rs.MoveFirst
   Do While Not rs.EOF
      For i = 0 To rs.Fields.Count - 1 'If your first field is autonumber, you can change 0 to 1
         If rs.Fields(i) = "X" Then intX = intX + 1
         If rs.Fields(i) = "Y" Then intY = intY + 1
      Next
      If intX > 0 Then
         With rs
            .Edit
            .Fields("CountX") = intX
            .Update
         End With
         intX = 0
      End If
      
      If intY > 0 Then
         With rs
            .Edit
            .Fields("CountY") = intY
            .Update
         End With
         intY = 0
      End If
      rs.MoveNext
   Loop
End If

Set rs = Nothing

End Sub

 

[Micron]

This would be the 'set field to zero' code:

Sub CountxyB()
Dim rs As DAO.Recordset
Dim intX As Integer, intY As Integer, i As Integer

Set rs = CurrentDb.OpenRecordset("sheet1")
If Not (rs.BOF And rs.EOF) Then
   rs.MoveFirst
   Do While Not rs.EOF
      For i = 0 To rs.Fields.Count - 1
         If rs.Fields(i) = "X" Then intX = intX + 1
         If rs.Fields(i) = "Y" Then intY = intY + 1
      Next
      With rs
         .Edit
         .Fields("CountX") = intX
         .Fields("CountY") = intY
         .Update
      End With
      intX = 0
      intY = 0
      rs.MoveNext
   Loop
End If

Set rs = Nothing

End Sub