New to this so bear with me.
I want to automatically insert a certain number or rows based on a value in another column. Can this be done?
eg
Container Lifts
B0237 1
B0238 7
B0239 7
A8783 2
So the containers would be split by the number of lifts
One for loop nested in a while loop should do your job. Why we are suing while instead of for because we can not dynamically change the limit of For loop when we add a new row in between existing data. So there you go:
Dim LastRow As Long
Dim RowAddNo As Long
LastRow = Range("A1").End(xlDown).Row
i = 2
While i <= LastRow
RowAddNo = Range("B" & i).Value
For J = 1 To RowAddNo
Rows(i + 1 & ":" & i + 1).Insert shift:=xlUp
LastRow = LastRow + 1
i = i + 1 'increasing the 'i' value to find the address for the next not empty row
Next
i = i + 1 'increasing the 'i' value to find the address for the next not empty row
Wend
PS: Do not try without i = i + 1. it goes in an endless loop :)
This will do it for you:
Sub AddRows()
Dim X As Long
For X = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1 'Work backwards when inserting or deleting rows, so much easier than incrementing numbers
Range("A" & X).Offset(1, 0).Resize(Range("B" & X).Value, 1).EntireRow.Insert 'Insert the number of rows against the target row offset by 1 ie below it
Next
End Sub
Related
maxRow = ws.UsedRange.EntireRow.Count
For n = 1 To maxRow
Do While Not IsEmpty(ws.Range("D" & n).Value)
ws.Range("D" & n & ":" & "E" & n).Delete shift:=xlShiftToLeft
Rows(n + 1).Insert shift:=xlShiftDown
maxRow = maxRow + 1
Loop
Next n
I was just wondering why my code always exit when n = 19 (number of original maxRow count). I added maxRow = maxRow +1 because I inserted one row so that it doesn't exit until it is finished.
What I am trying to do, is to remove the two cells (D&E) and inserting a row underneath until D&E is empty.
Thanks
You did not answer my question and I prepared an answer based on the assumption that the necessary code must replace the cells in D:E with their right neighbors (F:G) and insert a row after such a processed range. If this assumption is correct, please test the next code:
Sub testDeleteRangeInsertRow()
Dim ws As Worksheet, n As Long
Set ws = ActiveSheet
n = 2
Do While Not IsEmpty(ws.Range("D" & n).value)
ws.Range("D" & n & ":" & "E" & n).Delete Shift:=xlShiftToLeft
Rows(n + 1).Insert Shift:=xlShiftDown
n = n + 2
Loop
End Sub
If my assumption is wrong, please better explain (in words...) what do you need to accomplish...
I have gone crazy with vba projects around the house and helping my wife upping her reports to the next level. I’m having troubles putting down to VBA what I’m thinking. If anyone has felt my pain please shed some light on the actual script that would help me over this hump. Summary might be comparing cell value for certain text using InStr and if doesn't exist the appending characters to the right end. I can append and run thru one cycle of the loop but get confused with trying to write the logic I'm thinking.
Alittle background on the report: One row equals one reservation. Within that row there is a column labeled “Nights”. This column is filtered for any reservation with more than “1” Night. Example: could be 3 nights, 6 nights, and 10 nights doesn’t matter. I have a macro that sorts these reservations and splits the one reservation into multiple rows totaling the number value in the “Nights” column. Basically, copying and inserting the rows next to each other. While this filtered is still applied (SpecialVisibleCells Only). Now I have another column labeled “ResNumber”. With 3, 6, or 10 rows split out the “ResNumber” column is the same number. I’m tasked with walking down this ‘ResNumber” column and appending a “-1” for the first row. A “-2” for the second reservation “-3” for the third and possibly a forth “-4” Until the last row of the copied for that one reservation group. Then the cycle (loop) starts again on the next group or block of rows. Same procedure.
Dim lnrow As Integer
Dim llrow As String
Dim rownuml As Integer 'row checker
Dim colnuml As String 'column checker
Dim count As Integer
Dim total As String 'Value of reservation's "Nights" column Offset(,17)
Dim startnum As Integer 'Start number for counter
Dim actcell As String 'Activecell
startnum = 1
With sh
llrow = .Cells(.Rows.count, 2).End(xlUp).row
If llrow = "" Then Exit Sub
.Cells(2, 2).Resize(llrow - 1).SpecialCells(xlCellTypeVisible).Select
For lnrow = 2 To llrow
rownuml = ActiveCell.row
colnuml = ActiveCell.Column
total = ActiveCell.offset(, 17).Value
For count = 1 To total
rownuml = ActiveCell.row
colnuml = ActiveCell.Column
actcell = ActiveCell.Value
'Compares row 1 and checks resNumber value for "-1" if none exist it appends.
If InStr(ActiveCell.Value, "-1") = 0 Then
ActiveCell.Value = ActiveCell.Value & "-1"
Else
GoTo nexrow
End If
'Compares row 2 and checks resNumber value of above cell.
If InStr(ActiveCell.offset(-1, 0).Value, "-1") = 0 Then
Resume Next
If InStr(ActiveCell.Value, "-2") = 0 Then
ActiveCell.Value = ActiveCell.Value & "-2"
GoTo nexrow
End If
'to jump out of loop nexrow
'ActiveCell moves one row down.
ActiveCell.offset(1, 0).SpecialCells(xlCellTypeVisible).Select
rownuml = ActiveCell.row 'just checking row number
colnuml = ActiveCell.Column 'just checking column number
'since 1st reservation is already in the DB startnum starts at # 1. The counter
startnum = startnum + count
Next count
Next
End With
Try:
Option Explicit
Sub test()
Dim LastRow As Long, Times As Long, Counter As Long, i As Long, y As Long
Dim strNumber As String
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 2 To LastRow
strNumber = .Range("B" & i).Value
Times = Application.WorksheetFunction.CountIf(.Range("B2:B" & LastRow), strNumber)
If Times > 1 Then
Counter = 1
For y = 2 To LastRow
If strNumber = .Range("B" & y).Value Then
.Range("B" & y).Value = strNumber & " - " & Counter
.Range("D" & y).Value = 1
Counter = Counter + 1
End If
Next y
End If
Next i
End With
End Sub
Results:
i have an excel table with +19k lines.
Let's assume table has 2 columns ( Departmant,id).
there are 25 departments that each has unique id.
What formula can i use to get each of them's id correctly.
i tried using if, but i guess it doesnt work with + 25 if's in it..
is there any easy way to do it ?
i'm a beginnner and i'm working on this table for 3 days!.
Taken from MrExcel.com. Untested
Sub FindDistinctValues()
Dim LastRowFrom As Long
Dim LastRowTo As Long
Dim i As Long, j As Long
Dim temp As Integer
Dim found As Boolean
'determines the last row that contains data in column A
LastRowFrom = Range("A" & Rows.Count).End(xlUp).Row
'Loop for each entry in column A
For i = 2 To LastRowFrom
'get the next value from column A
temp = Range("A" & i).Value
'Determine the last row with data in column B
LastRowTo = Range("B" & Rows.Count).End(xlUp).Row
'initialize j and found
j = 1
found = False
'Loop through "To List" until a match is found or the list has been searched
Do
'check if the value exists in B column
If temp = Range("B" & j).Value Then
found = True
End If
'increment j
j = j + 1
Loop Until found Or j = LastRowTo + 1
'if the value is not already in column B
If Not found Then
Range("B" & j).Value = temp
End If
Next i
End Sub
In excel i have two column,one is the url and in second column i have numeric values and i want to insert blank rows based on second column numeric value.Values are just like this
first column Second Column
www.google.com 25
www.weslez.com 10
My reqirment is to insert 25 blank rows below first row and 10 blank rows below second row..thanks.
See code below:
Sub InsertRows()
Dim End_Row As Long, n As Long, Ins As Long
End_Row = Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For n = End_Row To 1 Step -1
Ins = Cells(n, "B").Value
If Ins > 0 Then Range("B" & n + 1 & ":B" & n + Ins).EntireRow.Insert
Next n
End Sub
Regards
Xsi
I have data in excel that looks like this
{name} {price} {quantity}
joe // 4.99 // 1
lisa // 2.99 // 3
jose // 6.99 // 1
Would it be hard to make a macro that will take the quantity value ("lisa // 3.99 // 3") and add that many rows below it's current location. It would know which rows to copy, and how many rows to insert based on on the quantity column.
Thanks for reading, and feedback is helpful.
This will do what you want, it polls through from the bottom up, if it encounters a number in C and it is > 1 then it will insert the number of rows equal to column C number - 1 then copy the data from the host row.
This will give you 4 equal rows where there is a 4 in column C, I think that is what you were after yes? If you want to ADD the number of rows equal to column C (So a value of 4 would add 4 NEW rows making the total count for that entry become 5) then let me know, it will be simple enough to change this
Sub InsertRowsByQTY()
Dim X As Long
For X = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If IsNumeric(Range("C" & X).text) Then
If Range("C" & X).Value > 1 Then
Rows(X + 1).Resize(Range("C" & X).Value - 1, Columns.Count).Insert
Range("A" & X + 1).Resize(Range("C" & X).Value - 1, Cells(X, Columns.Count).End(xlToLeft).column).Value = Range("A" & X).Resize(1, Cells(X, Columns.Count).End(xlToLeft).column).Value
End If
End If
Next
End Sub
Another method :
Sub insert()
Dim lastrow As Integer, frow As Integer
lastrow = Range("C65536").End(xlUp).Row
frow = 0
For i = 2 To lastrow
If Cells(i, 3) > 1 Then
frow = frow + Cells(i, 3)
End If
Next i
For i = 2 To lastrow + frow
If Cells(i, 3) <> 1 Then
nr = Cells(i, 3)
Rows(i + 1 & ":" & i + nr).Select
Selection.insert Shift:=xlDown
Rows(i & ":" & i + nr).Select
Selection.FillDown
i = i + nr
End If
Next i
End Sub