Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 400
  • Last Modified:

Add number line count to match inserted lines

The attached report has a macro that was something I received previous help on, but now I have a secondary issue.  The Macro reads the amount of recordings in Column C, it then copies and inserts the number of lines.  

My question is, is there a way to have Column E read column C as well and then after the lines are inserted it inserts into numeric order.  So if column C reads three, in Column E after the Macro is done or during it, it would enter into Column E, 0010, 0020, 0030, or if more than 9 lines would do 0090, 0100, 0110, etc.

Please let me know if this is possible, and any help is always greatly appreciated.
0
NYANBCNY32
Asked:
NYANBCNY32
  • 3
  • 2
1 Solution
 
NYANBCNY32Author Commented:
0
 
John EastonDirectorCommented:
There may be a more elegant method, but the below should do as you describe.  Replace your existing macro with the below and then run:

Sub CopyRows()
Dim c, i, r, l As Integer
Dim Ind

c = 0
i = Range("C2").Value
r = 2

  For rc = 1 To ActiveSheet.UsedRange.Rows.Count - 1
    If i > 1 Then
      Ind = 1
      For l = 1 To i - 1
        Rows(r + c).Select
        Selection.Copy
        Rows(r + c + 1).Select
        Selection.Insert Shift:=xlDown
        Application.CutCopyMode = False
        Range("E" & r + c).Value = "'" & Format(Ind * 10, "0000")
        Ind = Ind + 1
        c = c + 1
      Next l
        Range("E" & r + c).Value = "'" & Format(Ind * 10, "0000")
        i = Range("C" & r + c + 1).Value
      End If
    c = c + 1
  Next rc
End Sub

Open in new window

0
 
NYANBCNY32Author Commented:
This is working for all records unless there is one "1" entry, is there a way to also include that if there's 1 record then it will continue and put "0010" in column E.  Right now it doesn't move if the first entry is a 1, or if an entry down further is a 1 it stops.
0
 
John EastonDirectorCommented:
I think this was an error in the original formula which I didn't spot.  The below should deal with rows where Recordings equal 1 now:

Sub CopyRows()
Dim c, i, r, l As Integer
Dim Ind

c = 0
i = Range("C2").Value
r = 2

  For rc = 1 To ActiveSheet.UsedRange.Rows.Count - 1
    Ind = 1
    Range("E" & r + c).Value = "'" & Format(Ind * 10, "0000")
    If i > 1 Then
      For l = 1 To i - 1
        Rows(r + c).Select
        Selection.Copy
        Rows(r + c + 1).Select
        Selection.Insert Shift:=xlDown
        Application.CutCopyMode = False
        Ind = Ind + 1
        Range("E" & r + c + 1).Value = "'" & Format(Ind * 10, "0000")
        c = c + 1
      Next l
    End If
    i = Range("C" & r + c + 1).Value
    c = c + 1
  Next rc
End Sub

Open in new window

0
 
NYANBCNY32Author Commented:
Excellent! Thank you for the help on this piece.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now