VBA Count and paste value

shelim481

New Member
Joined
Aug 30, 2018
Messages
28
Hi im trying to find out how to count the numbers in each group, using macro instead of formula, the group go on for as many as needed, i want it so that it does number part for me...once i have filed out group and name...



GroupNameNumber
G1ASJ2
ATT
G2AMM4
MKK
TST
ST2
G3RT43
YT4
MK

<tbody>
</tbody>
And So forth....



Any ideas?
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Save a copy of your file and then try:
Code:
Sub M1()

    Dim x       As Long
    Dim y       As Long
    Dim arr()   As Variant
    
    x = Cells(Rows.Count, 2).End(xlUp).Row
    arr = Cells(1, 1).Resize(x, 3).Value
    
    For x = UBound(arr, 1) To LBound(arr, 1) + 1 Step -1
        y = y + 1
        If Len(arr(x, 1)) > 0 Then
            arr(x, 3) = y
            y = 1
        End If
    Next x
    
    Cells(1, 1).Resize(UBound(arr, 1), 3).Value = arr
    
    Erase arr

End Sub
This assumes your data starts in A1, has headers and column B defines the last used row for the table
 
Last edited:
Upvote 0
Another option
Code:
Sub shelim481()
   Dim Rng As Range
   For Each Rng In Range("A2", Range("B" & Rows.Count).End(xlUp).Offset(, -1)).SpecialCells(xlBlanks).Areas
      Rng.Offset(-1, 2).Resize(1).Value = Rng.Count + 1
   Next Rng
End Sub
 
Upvote 0
Glad we could help & thanks for the feedback
 
Upvote 0
Ok, how about
Code:
Sub shelim481()
   Dim rng As Range
   Dim i As Long
   For Each rng In Range("A2", Range("B" & Rows.Count).End(xlUp).Offset(, -1)).SpecialCells(xlBlanks).Areas
      rng.Offset(-1, 2).Resize(1).Value = rng.Count + 1
   Next rng
   For Each rng In Range("A2", Range("B" & Rows.Count).End(xlUp).Offset(, -1)).SpecialCells(xlConstants).Areas
      If rng.Count > 1 Then
         For i = 1 To rng.Count - 1
            rng(i).Offset(, 2) = 1
         Next i
      End If
   Next rng
End Sub
 
Upvote 0
sorry about this, but now i realised if all the groups are only one, i get error message no cells found...
 
Upvote 0
Try
Code:
Sub shelim481()
   Dim rng As Range
   Dim i As Long
   On Error Resume Next
   For Each rng In Range("A2", Range("B" & Rows.Count).End(xlUp).Offset(, -1)).SpecialCells(xlBlanks).Areas
      rng.Offset(-1, 2).Resize(1).Value = rng.Count + 1
   Next rng
   On Error GoTo 0
   For Each rng In Range("A2", Range("B" & Rows.Count).End(xlUp).Offset(, -1)).SpecialCells(xlConstants).Areas
      If rng.Count > 1 Then
         For i = 1 To rng.Count - 1
            rng(i).Offset(, 2) = 1
         Next i
      End If
   Next rng
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top