I have the below code to insert rows. I find that it is a bit slow. v is the number of rows to add and lRow + 1 is the start position to add from.
For q = 1 To v
ExpectedFeesTbl.ListRows.Add (lRow + 1)
ExpectedFeesTbl.ListRows(lRow).Range.Copy
ExpectedFeesTbl.ListRows(lRow + 1).Range.PasteSpecial Paste:=xlPasteFormats
ExpectedFeesTbl.ListRows(lRow + 1).Range.PasteSpecial Paste:=xlPasteFormulas
Application.CutCopyMode = False
Next q
Thanks
You don't need to add rows in the loop, seeing how you know the amount of rows to add. Adding all v rows outside the loop at once should speed up the code.
'Add rows
ExpectedFeesTbl.Rows(lRow + 1).EntireRow.Resize(v).Insert Shift:=xlDown
'Copy information to new rows
For q = 1 To v
ExpectedFeesTbl.ListRows(lRow).Range.Copy
ExpectedFeesTbl.ListRows(lRow + 1).Range.PasteSpecial Paste:=xlPasteFormats
ExpectedFeesTbl.ListRows(lRow + 1).Range.PasteSpecial Paste:=xlPasteFormulas
lRow = lRow + 1
Next q
Application.CutCopyMode = False
note that I added lRow = lRow + 1 because in your original cost the definition of lRow did not change and therefore each iteration of the loop copied from and pasted to the exact same locations.
Additionally, it may be possible to boil down the copy-pasting to a structure that doesn't require a loop. That depends on your workbook structure though
Related
I have a large set of data that needs to be broken up based on group type in column 4. The goal of the loop is to insert three blank rows and copy-paste the sheet's header on top of the new group. This should continue until the bottom row row. However, it seems like my lastrow3 isn't updating within the loop to account for the new rows inserted. Is there anything I'm missing in re-designating the last row within this For-Next Loop? Thanks!
Dim lastrow3 As Integer, Dim b As Integer
Range("A1").End(xlDown).Select
lastrow3 = ActiveCell.Row
For b = 2 To lastrow3
If Cells(b, 4) <> Cells(b + 1, 4) Then
Rows(b + 1).Resize(3).EntireRow.Insert
Rows("1").Copy
Rows(b + 3).PasteSpecial xlPasteFormats
Rows(b + 3).PasteSpecial xlPasteValues
lastrow3 = lastrow3 + 3
b = b + 4
End If
Next
UPDATED. #garbb makes the right call in the comments. Your For loop is flawed in that you're setting it to end at a specific integer, however this number could change. Basically, you want the loop to continue until it reaches the cell that was was originally marked, taking into account the inserted rows. This can be accomplished by using a Do-While loop which evaluates the row number of that cell if it's set to a variable. As a variable, it will update as you insert rows which addresses your issue.
I tested this out and it should work. Make sure the b=b+1 is in the proper spot. I can't tell without seeing what you did.
Dim theEndRange As Range
Set theEndRange = Range("A1").End(xlDown)
Dim b As Long
b = 2
'set the looping rule here
'theEndRange will update as rows are inserted.
Do While b <= theEndRange.Row
If Cells(b, 4) <> Cells(b + 1, 4) Then
Rows(b + 1).Resize(3).EntireRow.Insert
Rows("1").Copy
Rows(b + 3).PasteSpecial xlPasteFormats
Rows(b + 3).PasteSpecial xlPasteValues
b = b + 4
Else
'without this your code will loop indefinitely!!
'if this is causing an issue, it may need to place outside if statement
b = b + 1
End If
'or here
'b = b+1
Loop
Copy and Pasting an entire row based off of two conditions
For a school project, I am trying to find all the rows that satisfy both (of two) conditions then paste the entire row at the end of my data set. I am trying to do this with variables as the spreadsheet may change in tests that my professor will perform. I keep getting a "Subscript out of range" error. My reading and assigning to P and T, for loop, if statements, and count functions all work.
numrow = Rows(Rows.Count).End(xlUp).row
numcolumn = Columns(Columns.Count).End(xlUp).Column
P = Range(Cells(3, 1), Cells(numrow, 1)).Value
T = Range(Cells(3, 2), Cells(numrow, 2)).Value
For i = LBound(P, 1) To UBound(P, 1)
If P(i, 1) = 5 And T(i, 1) = 100 Then
countrow = countrow + 1 'check: return is 25
'Range(i, numcolumn).copy Sheets("Sheet1").End(xlUp).Offset(1, 0)
Worksheets("Sheet1").Range(Cells(i, numcolumn)).Value.copy
lastrow = ActiveSheet.Cells(1, 1).CurrentRegion.Rows.Count + 1
Range(Cells(lastrow, 1)).PasteSpecial xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False
'I would also like to change all the cells that were just pasted in the first column to the value of 2.5 here, but I have no idea where to start with that
End If
Next i
As you can see I tried it two ways
1.)
Range(i, numcolumn).copy Sheets("Sheet1").End(xlUp).Offset(1, 0)
(which is commented for now)
2.)
Worksheets("Sheet1").Range(Cells(i, numcolumn)).Value.copy
both get highlighted when I try to debug and have the "subscript out of range" error
I have an Excel spreadsheet with data in two columns as Time and Temperature. The Time column has values such as follows, where there are some skipped seconds:
2017-10-17 14:18:15
2017-10-17 14:18:17
2017-10-17 14:18:18
2017-10-17 14:18:19
2017-10-17 14:18:21
2017-10-17 14:18:22
Is it possible to have Excel add in those missing times with a corresponding blank row (so then I can do interpolation on those blank spots?)
I am not sure how your data look like but this is what you can do if you don't want to use VBA.
Use this formula from cell B2 and drag down:
=IF(B1="","",IF(N(B1),IF(ROW(A2)-ROW($A$1)-1<SECOND(MAX($A$2:$A$7)-MIN($A$2:$A$7))+1,B1+TIME(0,0,1),""),A2))
What this does is to determine how many seconds between max and min and then use the rows as a reference (you can change this part based on your data structure). Try and see if this works for you or not.
Try this! It assumes your times are in column A, with a header in cell A1
Sub AddRows()
'Finds out what row to go up to
Dim lRow As Long
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lRow + 1
'If the difference between the cell below is more than a second, then add a
row above and skip the next i
If Cells(i + 1, 1) - Cells(i, 1) > 0.000011575 Then
Cells(i + 1, 1).Select
Selection.EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
lRow = lRow + 1
Cells(i + 1, 1).Select
Cells(i + 1, 1).Value = Cells(i, 1).Value + 0.000011575
i = i + 1
Else
End If
Next i
End Sub
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 8 months ago.
Improve this question
I have a spreadsheet in which there are rows of data entered which need to be split.
Currently, this is a manual process, I have provided a link to the workbook when I have split the steps I have been doing into worksheets:
https://www.dropbox.com/s/0p3fg94pa61e4su/Example.xlsx?dl=0
When done manually the logical process is to first split by columns E (Temp) and F (Location) as these are directly linked to each other, then insert a blank row underneath so they are separated as shown in the worksheet step 1.
Then the next step is to split by column B Samples and copy the rows down from above in the range A:Y to reach the end result.
What is the best way to approach this as I am to use keyboard shortcuts to make it quicker but if it is possible to put this into a macro would save literally hours a week!
I believe the following should work for you.
Sub strata_data()
Dim t As Long, s As Long, rw As Long
Dim vTEMPs As Variant, vSAMPLEs As Variant, vOVENs As Variant
Application.ScreenUpdating = False
With Worksheets("Start2") '<~~set this worksheet name correctly
For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 6 Step -1
vSAMPLEs = Split(.Cells(rw, 2).Value2, Chr(44))
vTEMPs = Split(.Cells(rw, 5).Value2, Chr(44))
vOVENs = Split(.Cells(rw, 6).Value2, Chr(44))
For t = UBound(vTEMPs) To LBound(vTEMPs) Step -1
.Cells(rw + 1, 1).Resize(2 + (t = LBound(vTEMPs)), 1).EntireRow.Insert
.Cells(rw, 1).Resize(1, 7).Copy Destination:=.Cells(rw + 1 + (t = LBound(vTEMPs)), 1)
.Cells(rw + 1 + (t = LBound(vTEMPs)), 5) = CLng(vTEMPs(t))
.Cells(rw + 1 + (t = LBound(vTEMPs)), 6) = vOVENs(t)
.Cells(rw + 1 + (t = LBound(vTEMPs)), 5).NumberFormat = "0° \C"
.Cells(rw + 2 + (t = LBound(vTEMPs)), 1).Resize(1, 25).ClearContents
.Cells(rw + 2 + (t = LBound(vTEMPs)), 1).Resize(1, 25).Interior.Pattern = xlNone
If CBool(UBound(vSAMPLEs)) Then
.Cells(rw + 1 + (t = LBound(vTEMPs)), 1).Resize(1, 25).Copy
.Cells(rw + 1 + (t = LBound(vTEMPs)), 1).Resize(UBound(vSAMPLEs), 25).Insert Shift:=xlDown
For s = UBound(vSAMPLEs) To LBound(vSAMPLEs) Step -1
.Cells(rw + 1 + s + (t = LBound(vTEMPs)), 2) = vSAMPLEs(s)
Next s
End If
Next t
Next rw
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
There were some ones in column to the right of column G. I didn't know if they were seeded data so I left them alone. You should be able to clear them out with a simple .ClearContents command if they are unnecessary.
I'm experimenting with recursive for the first time. In this problem, I have a huge dataset with many rows, and in each row, there's N number of 4 cell ranges to copy (from column O to column GB). I have the following function written:
Function Recursive(Rng As Range)
If N = 1 Then
Rng.Offset(, -3).Resize(, 670).Copy
Rng.Offset(1, -3).Insert Shift:=xlDown
Rng.Offset(, 6).Resize(, 4).Copy
Rng.PasteSpecial Paste:=xlPasteValues
Else
Rng.Offset(, -2).Resize(, 670).Copy
Rng.Offset(1, -2).Insert Shift:=xlDown 'Repeat these two lines N times'
Rng.Offset(, 7 + 4 * N).Resize(, 3).Copy
Rng.Offset(N, 0).PasteSpecial Paste:=xlPasteValues
Recursive (N - 1)
End If
N = 0
End Function
I know it's pretty rough, and I see some problems already. Basically, if N is equal to 4, then I want the first two lines of the Else instruction to be repeated 4 times, then move on to carry out the next three lines over and over until N is equal to 1. Basically, where there are many ranges going across the dataset, I want to create a new line to put them into, including the cells to the left of Rng. Is it possible to put in a line where I've made my comment, that says "Go back and repeat these two lines N times?"
To elaborate on #MarcB's comment, there are many types of loops. I've chosen to do one main loop which reduces N by 1 until N = 0. Within that loop, if N = 1, then your special N = 1 code runs; otherwise if N = 4, it loops 4 times over that section of code, otherwise it runs your 'else' block of code.
Function Recursive(Rng As Range)
Dim OriginalN as Integer
OriginalN = N
While N <> 0
If N = 1 Then
Rng.Offset(, -3).Resize(, 670).Copy
Rng.Offset(1, -3).Insert Shift:=xlDown
Rng.Offset(, 6).Resize(, 4).Copy
Rng.PasteSpecial Paste:=xlPasteValues
ElseIf N = OriginalN Then
For x = 1 To OriginalN
Rng.Offset(, -2).Resize(, 670).Copy
Rng.Offset(1, -2).Insert Shift:=xlDown 'Repeat these two lines N times'
Next x
Else
Rng.Offset(, 7 + 4 * N).Resize(, 3).Copy
Rng.Offset(N, 0).PasteSpecial Paste:=xlPasteValues
Recursive (N - 1)
End If
N = N - 1
Wend
End Function
You refer to 'going back' and redoing code, but using a GoTo statement is often considered sloppy if there are other methods available, as without proper care GoTo statements can run incorrectly/indefinately, and are somewhat harder to read.