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?
 
I modified it for my needs and it works, just one last thing, how would i use this columns instead of rows, so say group, name and number was arranged in columns... ??
 
Upvote 0

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Change the ranges so that it is looking at a row, rather than a column.
 
Upvote 0
i tried this but it not working...


On Error Resume Next
For Each rng In Range("G1", Range("2" & Columns.Count).End(xlToLeft).Offset(, -1)).SpecialCells(xlBlanks).Areas


Range("T" & Cells(Rows.Count, "T").End(xlUp).Row + 1).Value = rng.Count + 1



Next rng

On Error GoTo 0
For Each rng In Range("G1", Range("2" & Columns.Count).End(xlToLeft).Offset(, -1)).SpecialCells(xlConstants).Areas

If rng.Count > 1 Then
For i = 1 To rng.Count



Range("T" & Cells(Rows.Count, "T").End(xlUp).Row + 1).Value = 1


Next i
End If
Next rng
 
Upvote 0
Can you post what your data looks like please.
 
Upvote 0
TY1TY2TY3
1233243547667765765567

<tbody>
</tbody>


so it should give 4,2,2

I got the below code partially working but it gives some weird last numbers
Code:
    On Error Resume Next
    For Each rng In Range("G1", Range("G2" & Columns.Count).End(xlToRight).Offset(, -1)).SpecialCells(xlBlanks).Areas


    Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).Value = rng.Count + 1
   


    Next rng
    
    On Error GoTo 0
    For Each rng In Range("G1", Range("G2" & Columns.Count).End(xlToRight).Offset(, -1)).SpecialCells(xlConstants).Areas
    
      If rng.Count > 1 Then
         For i = 1 To rng.Count
         
  
         
             'Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).Value = 1


         Next i
      End If
      Next rng
 
Last edited:
Upvote 0
Assuming that TY1 is in G1 try
Code:
Sub shelim481()
   Dim rng As Range
   Dim i As Long
   On Error Resume Next
   For Each rng In Range("G1", Cells(2, Columns.Count).End(xlToLeft).Offset(-1)).SpecialCells(xlBlanks).Areas
      rng.Offset(2, -1).Resize(, 1).Value = rng.Count + 1
   Next rng
   On Error GoTo 0
   For Each rng In Range("G1", Cells(2, Columns.Count).End(xlToLeft).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
Hi


found a big error with the macro, please help, basically when you have bunch of multiple groups then at the end only have a group of 1 it does not show for the last one...
Code:
[COLOR=#333333]Sub shelim481()[/COLOR]   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 [COLOR=#333333]End Sub[/COLOR]

GroupName Number
fdfsdsa3
fdf
dsad
fdfsdsa1
gfgdggfddgfd3
dfgfdgfd
fddgddfgfd
fdsgfdgfd1
fdgfdgfd3
gfd
dfgfdgfd
fdgfdg

<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>
</tbody>


the last one does not show...any ideas?
 
Upvote 0
How about
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
      Debug.Print Rng.Address
      If Rng.Count > 1 Then
         For i = 1 To Rng.Count - 1
            Rng(i).Offset(, 2) = 1
         Next i
      End If
      If Rng.Offset(Rng.Count - 1).Resize(1).Address = Range("B" & Rows.Count).End(xlUp).Offset(, -1).Address Then
         Rng.Offset(, 2) = 1
      End If
   Next Rng
End Sub
 
Upvote 0
that works now under all circumstances, im trying to change the column one, but keep getting errors could you have a look please...

Code:
    For Each rng In Range("G1", Cells(2, Columns.Count).End(xlToLeft).Offset(-1)).SpecialCells(xlBlanks).Areas    rng.Offset(2, -1).Resize(, 1).Value = rng.Count + 1
    Next rng
    On Error GoTo 0
    For Each rng In Range("G1", Cells(2, Columns.Count).End(xlToLeft).Offset(-1)).SpecialCells(xlConstants).Areas
      Debug.Print rng.Address
      If rng.Count > 1 Then
         For i = 1 To rng.Count - 1
            rng(i).Offset(2) = 1
         Next i
      End If
            If rng.Offset(rng.Count - 1).Resize(1).Address = Range(2, Columns.Count).End(xlToLeft).Offset(-1).Address Then
         rng.Offset(, 2) = 1
      End If
    Next rng
 
Upvote 0
Try
Code:
      If Rng.Offset(, Rng.Count - 1).Resize(, 1).Address = Cells(2, Columns.Count).End(xlToLeft).Offset(-1).Address Then
         Rng.Offset(2) = 1
      End If
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,239
Members
448,555
Latest member
RobertJones1986

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