VBA Count and paste value
Page 2 of 3 FirstFirst 123 LastLast
Results 11 to 20 of 22

Thread: VBA Count and paste value

  1. #11
    New Member
    Join Date
    Aug 2018
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA Count and paste value

    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... ??

  2. #12
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    27,051
    Post Thanks / Like
    Mentioned
    461 Post(s)
    Tagged
    46 Thread(s)

    Default Re: VBA Count and paste value

    Change the ranges so that it is looking at a row, rather than a column.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  3. #13
    New Member
    Join Date
    Aug 2018
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA Count and paste value

    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

  4. #14
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    27,051
    Post Thanks / Like
    Mentioned
    461 Post(s)
    Tagged
    46 Thread(s)

    Default Re: VBA Count and paste value

    Can you post what your data looks like please.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  5. #15
    New Member
    Join Date
    Aug 2018
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA Count and paste value

    TY1 TY2 TY3
    123 32 43 54 7667 765 765 567


    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 by shelim481; Aug 14th, 2019 at 07:37 AM.

  6. #16
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    27,051
    Post Thanks / Like
    Mentioned
    461 Post(s)
    Tagged
    46 Thread(s)

    Default Re: VBA Count and paste value

    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
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  7. #17
    New Member
    Join Date
    Aug 2018
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA Count and paste value

    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:
    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
    Group Name Number
    fdf sdsa 3
    fdf
    dsad
    fdf sdsa 1
    gfgdg gfddgfd 3
    dfgfdgfd
    fddgddfgfd
    fds gfdgfd 1
    fd gfdgfd 3
    gfd
    dfgfdgfd
    fdgfd g


    the last one does not show...any ideas?

  8. #18
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    27,051
    Post Thanks / Like
    Mentioned
    461 Post(s)
    Tagged
    46 Thread(s)

    Default Re: VBA Count and paste value

    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
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  9. #19
    New Member
    Join Date
    Aug 2018
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA Count and paste value

    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

  10. #20
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    27,051
    Post Thanks / Like
    Mentioned
    461 Post(s)
    Tagged
    46 Thread(s)

    Default Re: VBA Count and paste value

    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
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •