Excel VBA - add rows as described in table

I am trying to replicate this view where new rows in the bottom table are created based on the values ​​in column "A" in the top table.

Here is my code:

Sub testProc()
Worksheets("Sheet1").Activate
Dim r, count As Range
Dim LastRow As Long
Dim temp As Integer
'Dim lngLastRow As Long

Set r = Range("A:L")
Set count = Range("A:A")
LastRow = Range("F" & 9).End(xlUp).Row
'LastRow = Cells(Rows.count, MyRange.Column).End(xlUp).Row
For n = LastRow To 1 Step -1
    temp = Range("A" & n)
    If (temp > 0) Then
        Rows(n + 1 & ":" & n + temp).Insert Shift:=xlDown
        Range("H" & (ActiveCell.Row) - 2).Copy Range("E" & (ActiveCell.Row) - 1)
        Range("G" & (ActiveCell.Row)).Select

        'ActiveCell.Offset(RowOffset:=1, ColumnOffset:=-6).Activate
        'Cells(ActiveRow, 8).Value.Cut
        'Cells.Offset(2 - 6).Value.Paste

        'Range("G" & (ActiveCell.Row)).Select
        'ActiveCell.Offset(0 - Selection.Column + 1).Range("A1:AG1").Select
        'Value = Range(G, H)
        'ActiveCell.Offset(1, -6).Paste
        'ActiveCell.Offset(1, -6).Paste
        'ActiveCell.Offset(RowOffset:=1, ColumnOffset:=-6).Paste

        'Range.Offset(1, -6).Paste
        'Value = Range("G" & (ActiveCell.Row), "H" & (ActiveCell.Row)).Value

        'ActiveCell.Offset(2, -6).Range


        'ActiveCell.Offset(rowOffset:=3, columnOffset:=3).Activate

    End If
Next n
End Sub

      

I don't know what I am doing and Excel crashes and no messages

+3


source to share


1 answer


The simplest solution for this is to use two separate sheets, but you can easily get around this with some math or a reserved word cell. You also want to use as few reference variables as possible and let Excel tell you which ranges are defined as using contiguous ranges.

I won't write the whole function for you, but give you the building blocks that allow you to put them together and hopefully you learn more how you do it.

Here's how to set up the object variables that you will refer to throughout your code:

Dim sourceSheet as Worksheet
Dim targetSheet as Worksheet

' replace with the names of sheets you want to use
sourceSheet = Worksheets("Sheet1")
targetSheet = Worksheets("Sheet2")

      

Now, to scroll through the original table. If you know that the first line in a Sheet is always the header line, and your statements start on line 2, you can use it to loop through each statement:

Dim sourceRowIndex = 2

While Not IsEmpty(sourceSheet.cells(sourceRowIndex, 1))

  ' ** do stuff here

  ' increment row index
  sourceRowIndex = sourceRowIndex + 1

Wend

      

You can also use For Each or Next or Do loop, take your choice once you understand the logic used.

Note that Cells take two numbers - a row number, then a column number. This comes in very handy when you're looping through rows and columns and don't want to deal with addresses like A1 or C5.

This will loop through everything in the top table, but now you need to add an inner loop that will actually process the instructions. Add all the code below after "Bye" and "Before".

Finally, you need to add lines to Target. The trick here is to use the CurrentRegion property to figure out where the last row in the range is, and then just add one to get the next empty row.

Dim targetFirstEmptyRow

' Look up the Current Range of cell A1 on target worksheet
targetFirstEmptyRow = targetSheet.cells(1,1).CurrentRegion.Rows + 1

      



Then don't use copy and paste to assign values, just assign values ​​directly. This will create the first line you define:

targetSheet.cells(targetFirstEmptyRow, 1).value = sourceSheet.cells(sourceRowIndex, 1).value
targetSheet.cells(targetFirstEmptyRow, 4).value = sourceSheet.cells(sourceRowIndex, 4).value
targetSheet.cells(targetFirstEmptyRow, 5).value = sourceSheet.cells(sourceRowIndex, 5).value

      

Then after you select those three values, you can get the next empty row using this again (note that your original RowIndex hasn't changed):

targetFirstEmptyRow = targetSheet.cells(1,1).CurrentRange.Rows + 1

      

Using cell logic (row, column) it is quite easy to write the second line:

targetSheet.cells(targetFirstEmptyRow, 2).value = sourceSheet.cells(sourceRowIndex, 6).value
targetSheet.cells(targetFirstEmptyRow, 3).value = sourceSheet.cells(sourceRowIndex, 7).value
targetSheet.cells(targetFirstEmptyRow, 6).value = "Dev"

      

Adding the third line (when required) is almost exactly the same as the second. However, you want to check if the third line is needed:

If sourceWorksheet.cells(sourceRowIndex, 1) = 3 Then
  ' insert your third row here
End If

      

Here's the whole function in pseudocode so you can put it all together:

Set up worksheet variables
While loop through every Source row
  Find next empty row in Target
  Copy Row 1
  Find next empty row in Target
  Copy Row 2
  If 3 rows
    Find next empty row in Target
    Copy Row 3
  Increment Source Row Index
Wend

      

Finally, if you don't want the screen to blink (and you want to speed up your code execution a bit), have a look at Application.Screenupdating to disable screen redrawing, as that makes it work. Remember to turn it back on once you're done processing everything.

0


source







All Articles