I have a long list of codes such as 008.45, etc that will need multiple lines of text to explain them. I have the list of codes and I would like to know how I can automatically insert a row every, say, fifth row. Example Below
1
2
3
4
5
6
7
8
9
10...
100
Every five rows I would like to insert a given number of my choosing of rows. How can I do this? Thanks
Test with a range from row 1 to row 100.
Sub InsertRows()
For i = Sheet1.UsedRange.Rows.Count To 1 Step -5
For j = 0 To 4
Sheet1.Rows(i).Insert
Next
Next
End Sub
You would need to use a loop as below:
for i=1 to 100 step 1
if i mod 5 = 0 then
// Insert the rows
end if
next i
This worked great for me:
Sub add_rows_n()
t = 6
Do Until Cells(t, "A") = ""
Rows(t).Insert
t = t + 6
Loop
End Sub
To insert a row at row myRowNumber, your VBA code would look like this:
Rows(myRowNumber).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
You can incorporate that into Andy's answer.
Or you could use the modulus function like so:
=IF(MOD(ROW()-1,7),"",A1)
in B1, where A1 is the first number of your dataset.
NB: Change 7 to n to get every n'th row.
For example if I want 5 of my records between my rows of data I would use Mod 6, however, you need to allow for these new rows as they will affect the used range count! To do this you will want to add the number of rows that will be inserted to the length of the loop (eg. Absolute value of(numberOfRows/YourModValue)).
Code to do this:
Sub InsertRows()
For i = 1 To Sheet1.UsedRange.Rows.Count + Abs(Sheet1.UsedRange.Rows.Count / 6) Step 1
If i Mod 6 = 0 Then
Sheet1.Rows(i).Insert
Cells(i, 1).Value = "Whatever data you want in your new separator cell"
End If
Next i
End Sub
Here's the code I wound up with. Note that the FOR loop actually runs backwards from the end of UsedRange. The Mod 5 inserts a row every 5 rows.
For i = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
If (i - 1) Mod 5 = 0 Then
ActiveSheet.Rows(i).Insert Shift:=xlDown
End If
Next
Related
We need program that remove all rows with values in cell 6 like 2,3,4,5 and so on from column F1 and leave only rows with value 1 and heard of table top first row? Also we need leave fist row intact with table heard.why this code work wrong beacause it does not remove 10 100 and only remove 2,3,4,5 and so on.
Sub RemoveRows1()
ThisWorkbook.ActiveSheet.Cells.ClearFormats
Dim m As Long
m = 1
Do While m <= ThisWorkbook.ActiveSheet.Range("F1").CurrentRegion.Rows.Count
If not InStr(1, Thisworkbook.Activesheet.cells(m,6).value = 1) > 0 Then
ThisWorkbook.ActiveSheet.Cells(m, 6).EntireRow.Delete
Else
m = m + 1
End If
Loop
End Sub
Instead of that great big if in the loop, just use
If not InStr(1, ThisWorkbook.ActiveSheet.Cells(m, 6).Text, "1", vbTextCompare) > 0 Then
ThisWorkbook.ActiveSheet.Cells(m, 6).EntireRow.Delete
End If
And that will delete the entire row of anything where column F doesn't contain 1.
I want to use a code to repeat itself through many rows because it would take too much time writing one by one, i dont know if there's a code that takes from the chosen cell that i put the macro the column and row of it.
now in column 1 and row 1 as reference
if (current Column (1), current row (1) ) = 1 then
column number 3, current row = 1
end if
next
now in column 1 and row 2 as reference
if (current Column (1), current row (2) ) = 1 then
column number 3, current row = 1
end if
I wanted to copy paste to code to go on in the entire column 1, but i dont have any idea how to do that, could someone help please?
We can loop over rows:
Sub kayky()
Dim N As Long, i As Long
N = 123
For i = 1 To N
If Cells(i, 1).Value = 1 Then Cells(i, 3).Value = 1
Next i
End Sub
This handles 123 rows; modify to suit your data.
I'm trying to write a simple script that compares and flags similar transactions (rows) and pastes them at the bottom of the sheet. The transactions which are to be flagged should meet the following criteria.
The $amount in the transactions is greater than 4000 or less than -4000 (column 11)
The two transactions being compared have the same part number (column 3)
Two transactions with similar dollar amounts (between 90-110% of each other) and opposite in number sign
Sub checktrans()
Dim newLastRow, rowcount As Long
Dim row, row2, amountcol, partnumcolcol As Integer
amountcol = 16
partnumcol = 3
rowcount = 27307
newLastRow = 37309
For row = 1 To rowcount
For row2 = 1 To rowcount
If Cells(row, amountcol) > 4000 Or Cells(row, amountcol) < -4000 Then
If row <> row2 Then
If Cells(row, partnumcol) = Cells(row2, partnumcol) Then
If Abs(Cells(row, amountcol)) > 0.9 * Abs(Cells(row2, amountcol)) And Abs(Cells(row, amountcol)) < 1.1 * Abs(Cells(row2, amountcol)) Then
If (Cells(row, amountcol) < 0 And Cells(row2, amountcol) > 0) Or (Cells(row, amountcol) > 0 And Cells(row2, amountcol) < 0) Then
ActiveSheet.Rows(row).Copy
ActiveSheet.Rows(newLastRow).PasteSpecial xlPasteAll
newLastRow = newLastRow + 1
ActiveSheet.Rows(row2).Copy
ActiveSheet.Rows(newLastRow).PasteSpecial xlPasteAll
newLastRow = newLastRow + 1
End If
End If
End If
End If
End If
Next row2
Next row
End Sub
I wrote the code above, and it seems to work for a low number of rows (below 500), but when the number of rows exceeds 27000 it goes into a never ending loop that keeps pasting new rows onto the sheet. It also posts each couple of transactions twice, which I understand is flaw in the logic which I have to work out as well.
P.S I am a giant noob when it comes to this, haven't programmed much before, and I'm just learning now to make my life easier.
First thing you can do is to start second loop from the point where first loop is currently. Like For row2 = row + 1 to rowcount. You checked previous records already. This will also fix problem with duplicates and you can delete If row <> row2.
Second, is to use Application.ScreenUpdating = False at the beginning of the macro and Application.ScreenUpdating = True at the end. This turns off screen updating while your macro is running and can be a huge improvement in performance.
At the end you can join all Ifs into one using And, however I don't know if this will improve performance.
I am trying to find the first four cells along a row that contain values and the type is Double. I want to add the values of the cells to an array and also locate the cells locations for future use. I need to work down 23 rows after as well. Some of the rows don't contain any values. The matrix starts with cell AB3
I've been trying to start with a For loop so I can work down the rows and then having a For loop inside that to create a new array every time I move to a new row.
The code I need looks something like this.
For i = 3 to 27
For j = 0 to 3
TIGA(j) = Range(Cells(i, j + 28), Cells(last cell)).Find(first
value and then the next three)
Again I need to work across from left to right in each row. First I need to add the first four values in a row to an array. Next I need to save the column number for each of the values because I need to know what column they're in later on in my code. After I get the information for one your I need to loop it down for the rest. The array with the values and any variable/array used for the cells location can be restarted every time the code loops through for the new row. Thank you!
Here's what's the data looks like.
I changed things up a bit, I think this should suffice:
Sub Test()
Dim TIGA As Variant, i As Long, j As Long, k As Long
ReDim TIGA(0 To 3)
For i = 3 To 27
k = 0
For j = 28 To 40
If Cells(i, j) <> "" Then
If IsNumeric(Cells(i, j)) = True And InStr(Cells(i, j), ".") > 0 Then 'make sure it's a double
TIGA(k) = Cells(i, j)
k = k + 1
If k = 3 Then
Exit For
End If
End If
End If
Next j
Next i
End Sub
I need to compare one cell with next and if next is greater more than 3 than first, than to make it's color.
example: 1 2 6 3 2 8
1 compare with 2 = do not do nothing
2 compare with 6 = make it's color
6 compare with 3 = make it's color to
3 compare with 2 = do not do nothing
2 compare with 8 = make it's color.
Here is code that make cells less then 4 color, but I can't understand how to diff one cell with next :(
Sub Color()
Dim i As Integer
For i = 1 To 7
With ActiveSheet.Cells(i)
If .Value < 4 Then
.Interior.Color = QBColor(10)
End If
End With
Next i
End Sub
Upd:
Oh! Look like I have found solution!
Sub Color()
Dim i As Integer
For i = 1 To 7
With ActiveSheet.Cells(i)
If ActiveSheet.Cells(i) < ActiveSheet.Cells(i + 1) Then
ActiveSheet.Cells(i + 1).Interior.Color = QBColor(10)
End If
End With
Next i
End Sub
You could use conditional formatting for this rather than VBA, Debra covers this topic thoroughly here, http://www.contextures.com/xlcondFormat01.html
In your case:
Select A1:E1
Conditional Formatting ... New Rule (different menu options depending on your Excel version)
Use a formula to determine what cells to format
use =B1-A1>3 to add a relative formula
Pick a fill colour
screenshot from xl2010 below