This question already has answers here:
Closed 10 years ago.
Possible Duplicate:
Insert row every X rows in excel
I have a large set of data (let's say it goes from B5 to J500 and let's say this range is named rngOutput). I am trying to go through this data and add 2 empty rows every x number of rows where x is a number the user specifies. For example if x is 10 then every 10 rows 2 new rows should be inserted. Conceptually, this is the code that should work:
For i = 1 to Number of rows in rngOutput
If i mod x = 0 Then
Insert 2 Rows
End If
Next i
However, when you insert 2 new rows, the row count changes and the formula messes up (i.e. it adds 2 rows after the first 10 rows, then it adds another 2 rows after the next 8 rows (since it counts those 2 new rows you added as actual rows) then it adds another 2 rows after the next 6 rows, etc.
I am trying to figure out a way to accomplish adding 2 new rows every x number of rows cleanly to avoid the above problem.
Thank you for the help and please let me know if you need additional clarification!
This is like Chris's only fleshed out. When inserting or deleting rows you have to work up from the bottom:
Sub InsertXRowsEveryYRows_WithMeaningfulVariableNames()
Dim NumRowsToInsert As Long
Dim RowIncrement As Long
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim LastEvenlyDivisibleRow
Dim i As Long
NumRowsToInsert = 2 'any number greater than 0
RowIncrement = 10 'ditto
Set ws = ActiveSheet
With ws
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
LastEvenlyDivisibleRow = Int(LastRow / RowIncrement) * RowIncrement
If LastEvenlyDivisibleRow = 0 Then
Exit Sub
End If
Application.ScreenUpdating = False
For i = LastEvenlyDivisibleRow To 1 Step -RowIncrement
.Range(i & ":" & i + (NumRowsToInsert - 1)).Insert xlShiftDown
Next i
End With
Application.ScreenUpdating = True
End Sub
Count from the bottom of the range
For i = Number of rows in rngOutput to 1 step -1
If i mod x = 0 Then
Insert 2 Rows
End If
Next i
Related
This is a code I came up with until now
Sub RunMe()
Dim x As Integer
Dim sv As Integer
x = 11
sv = Range("MyTable").Rows.Count
Do
Rows(x).Resize(sv).Insert
x = x + sv
Loop Until IsEmpty(Cells(x, "A"))
End Sub
So basically this is supposed to insert blank cells in row 11. But the problem is it just adds blank cells at the end of the table instead after row 11. Is there any way to fix this? I am a pure beginner at VBA, this is my first time experimenting with it. Any help will be appreciated.
This could be achieved by:
LastRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
Sheet2.Range("A1:K" & LastRow).Copy 'amend to include the number of columns, also change 1 to 2 if using header and don't want to include them
Sheet1.Rows("11:11").Insert Shift:=xlDown
This will not create empty rows, but instead it will insert all the rows with data into Sheet1 Row 11.
So count the number of rows on Sheet2, then select the range to be copied, and finally inserting into row 11 of Sheet1.
UPDATED:
Sheet2.Range("MyTable").Copy
Sheet1.Rows("11:11").Insert Shift:=xlDown
Try this, for me it works quite ok:
Sub RunMe()
Dim x As Integer
Dim sv As Integer
x = 11
sv = Range("MyTable").Rows.Count + 1
Rows(x).Resize(sv).Insert
End Sub
If the table is with 23 rows, it inserts 23 empty rows after the 10. row.
I would like to thank everyone for their feedback so far it has helped a great deal. one question that I am grappling with is how to make my column values even so I can do a dynamic subtototal.
Column k Column R Column Y Column AF Column AM Column AT
1 2 4 2 3 5
3 9 7 8 2 4
2 3 6 3 5 8
3 3 2
5
TOT 9 14 25 13 12 17
Column k Column R Column Y Column AF Column AM Column AT
1 2 4 2 3 5
3 9 7 8 2 4
2 3 6 3 5 8
3 3 2
5
TOT 9 14 25 13 12 17
on a monthly basis the column values can fluctuate, the question is how do I use VBA to create a dynamic sum based on the column with the most values.
Dim Rin As Range
Dim Rout As Range
Dim lRa As Long
lRa = Range("i" & Rows.count).End(xlUp).Row
Set Rin = ws.Range("i" & lRa)
Set Rout = ws.Range("I" & lRa)
aCell.Range("I11:P12", "R12:AY12").Copy
Rout.Offset(2, 0).Resize(1, 28).Formula = "=SUBTOTAL(9," &
Rin.Address(0, 0) & ")"
lR = ws.Range("I" & Rows.count).End(xlUp).Row - 1 ' Finds the last blank
row
ws.Range("I" & lR).PasteSpecial xlPasteFormats
If you know where your data starts you can use a method such as that given by Shai Rado.
You can't have any entirely empty rows or columns in the range.
You can then feed this lastRow variable into the range address for adding your subtotal formula.
Example: If your data is a continuous set of populated columns starting at Cell D3 the following will get the last used row number in the range of columns:
Option Explicit
Public Sub AddSubTotal()
Dim lastRow As Long
Dim lastCol As Long
Dim firstRow As Long
Dim rowHeight As Long
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet2") 'change as appropriate
With ws.Range("D3").CurrentRegion 'change as appropriate
firstRow = .Rows(1).Row
lastRow = .Rows(.Rows.Count).Row
lastCol = .Columns(.Columns.Count).Column
rowHeight = lastRow - firstRow + 1
End With
With ws
.Range(.Cells(lastRow + 1, "D"), .Cells(lastRow + 1, lastCol)).FormulaR1C1 = "=SUBTOTAL(9,R[-" & rowHeight & "]C:R[-1]C)"
End With
End Sub
If you need a different method to find the last used row and last used column there a lots of available resources online including my favourite by Ron De Bruin Find last row, column or last cell. The appropriateness of each method is determined by the shape and properties of your range e.g. no blank columns or rows in range. So choose a method that is right for your data or that can test for different likely cases and apply different methodologies as appropriate.
It is quite difficult to give a definitive answer (and i don't want to code lots of different possible scenarios) to this question without knowing more about the nature and variability of the data. If you familiarise yourself with the methods of finding last row and column you will be able to implement those that suit your needs.
I'm a newbie to VBA/coding in general and my usual tactic of sticking bits of pre-written code isn't working for my problem.
I'm looking to create a macro that will do 3 things:
Allow me to find a starting point for the data in a column.
Start counting the number of rows once the cell value has
changed to a constant.
Once the value moves back to the starting point for the count to stop and record the number of cells counted in separate column with positioning of the count in that column at the start point of the count.
Repeat until the end of the data.
For this case the start point will be when the cell has a value of >0.
It will increase to a constant number (300).
Once at 300 the macro will have to count the number of rows that contain the numerical value 300 until the value goes back to 0.
Report count in a separate table on the worksheet with the entry being input at the same relative position in the new table as when the count started from the data.
And finally the loop.
I need to also do a similar count but in the horizontal direction (i.e. counting columns on a row). If anyone can create a code for the vertical/row count problem above I'd really appreciate it if you could annotate it so I can attempt to understand/learn which bits of code carry out each action and thus change it up for horizontal/column count.
I've attached a screenshot of the spreadsheet however as a new user it must be as a link. The blue highlighted table is the data used for the vertical /row count problem I am talking about. The blank table underneath the highlighted table has manually inputted correct answers for the first column of data for what I would like the macro to do in case I haven't accurately described my request.
I have also attached the horizontal table with correct manually inputted answers for row 1 in the separate table for the column count along the row.
Lastly, here is the code that I have written to tackle the problem, however it is very basic and won't run.
Sub Count0()
For Each c In Worksheets("Sheet1").Range("D30:D39")
If c.Value = 0 Then
End If
If c.Value > 0 Then
v = Range(c.Value)
For i = 3 To Rows.Count
If Cells(i, 1).Value <> v Then
MsgBox CStr(i - 2)
End If
Next i
Next c
End Sub
This worked in the limited case I tested (two columns and several rows in different patterns. It's pretty basic--there are more elegant ways to do it.
Sub Count0()
'To hold the current cell
Dim current As Range
'To hold the total number of rows and columns having data
Dim rows As Long
Dim cols As Long
'To iterate across rows and columns
Dim r As Long
Dim c As Long
'Flag/counter variables
Dim found As Long 'Saves row on which first "constant" was found
Dim count As Long 'Saves count of "contants"
'Use SpecialCells method to obtain the maximum number of rows and columns
' that have data.
cols = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Column
rows = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
'Increment through all columns that have data. This is a bit inefficient
' because it really isn't necessary to go through all the empty cells,
' but it works.
For c = 1 To cols
'Initialize flag/counter
found = 0
count = 0
'Increment through all rows for the current column.
For r = 1 To rows
'Examine the current cell
Set current = Worksheets("Sheet1").Cells(r, c)
'For positive values, save the first row that has the value
' and count the number of values.
If current.Value > 0 Then
If found = 0 Then found = r
count = count + 1
End If
'When the next non-positive value is reached--OR the end of the
' row is reached--and there was a constant found, write the count
' to the next worksheet in the cell corresponding to the row and
' column having the first instance of the constant.
If (current.Value <= 0 Or r = rows) And found > 0 Then
Worksheets("Sheet2").Cells(found, c).Value = count
'Reset the flag/counter
found = 0
count = 0
End If
Next r
Next c
End Sub
I was struggling with what you had written, and ended up doing this in the end. I left you variables for changing the sheets to read from and print to (assuming you can print the results to another sheet- if not it should be easy enough to change).
This should also work for all cells in your range, assuming that there are values in all boxes.
Problems I noted with your original code were:
The first if did nothing
I'm pretty sure you shouldn't use numbers in sub/function names
Dimensioning no variables is a bad idea
Anyway, give me a comment if you need any help (and well done for writing a good first question).
Sub CountZero()
Dim SourceSheet As Worksheet, SummarySheet As Worksheet
Dim CurrentCell As Range
Dim FirstRow As Long, LastRow As Long
Dim FirstColumn As Long, LastColumn As Long
Dim TotalValues As Long
Set SourceSheet = Worksheets("Sheet1")
Set SummarySheet = Worksheets("Sheet2")
FirstRow = 1
LastRow = SourceSheet.Range("A" & rows.count).End(xlUp).row
FirstColumn = 1
LastColumn = SourceSheet.Cells(1, Columns.count).End(xlToLeft).column
For col = FirstColumn To LastColumn
For Rw = FirstRow To LastRow
Set CurrentCell = SourceSheet.Cells(Rw, col)
If CurrentCell <> 0 Then
TotalValues = ProcessSection(CurrentCell)
SummarySheet.Cells(Rw, col).value = TotalValues
Rw = Rw + TotalValues
End If
Next Rw
Next col
End Sub
Function ProcessSection(FirstCellWithValue As Range) As Long
Dim Counter As Long: Counter = 0
Do Until FirstCellWithValue.Offset(Counter, 0).value <> FirstCellWithValue.value
Counter = Counter + 1
Loop
ProcessSection = Counter
End Function
As a small disclaimer, I haven't tested this, let me know if there are problems.
Dim i As Long
Dim rows As Long
Dim rng3 As Range
rows = rng3.rows.Count
For i = rows To 1 Step (-1)
Does anyone know how this loop works? I'm confused on the meaning of rows To 1 Step (-1).
from high number To 1 adding (-1) each iteration
Note: It's adding because + AND - in mathematical logic evaluate to a -
If rows = 10 then
for i = 10 to 1 step -2 would mean loop back from 10 to 1 subtracting 2 from the i in each loop cycle.
adding a Debug.Print i inside the loop may give you a better clue.
Note: turn ON the Immediate Window hitting CTRL+G or View => Immediate Window from the VBE menu bar
An example loop increasing by 3 on each cycle.
for i = 1 to 10 step 3
debug.print i
next i
Usage
The step-back technique is mostly used when deleting rows from a spreadsheet.
To see the logic in practice see the following
How to select and delete every 3rd column
Delete entire excel column if all cells are zeroed
Excel VBA - Scan range and delete empty rows
When deleting rows, it is often common practise to start at the end and step backwards, this is so no rows are skipped.
Dim i As Long
Dim rows As Long
Dim rng3 As Range
rows = rng3.rows.Count
For i = rows To 1 Step (-1)
'delete row if "delete" is in column 1
If rng3.cells(i,1).Value = "delete" Then
rng3.Rows(i).EntireRow.Delete
End If
next i
Dim i as Integer
For i = 1 To 14 Step 3
Debug.Print i
Next i
In above code loop will iterate from 1 to 14 increment with 3 so output will be like
1 4 7 10 13
It means it can not cross 14 that is limit.
So whatever value is provided in step it will add into the variable use for looping purpose. Here
i = i +3
But in For loop in VBA, Step value can not be changed dynamically. For example:
Dim i As Integer
For i = 1 To 10 Step i
Debug.Print i
Next i
Here, before starting iteration Step is equal to the value of i that is the default value i.e. 0. So i will increment like below:
i = i+ i => i = i+0
So i will not increment here and loop will iterate for ever.
Now for below code:
Dim i as Integer
For i = 1 To 14 Step i+1
Debug.Print i
Next i
i will increment like :
i=i+(i+1) => i= i+(0+1) =>i = i+1
so it will increment by 1 and output will be 1 2 3 .... 14
Now for below code :
Dim i As Integer
i = 3
For i = 1 To 10 Step i
Debug.Print i
Next i
here, i is equal to 3 before loop execution, so Step value will be 3, but loop will start with i = 1 and will increment with 3 through out the loop.
here,
i = i+3
so output will be 1 4 7 10.
Now for some other variable:
Dim i As Integer
Dim j As Integer
j = 2
For i = 1 To 10 Step j
Debug.Print i
j = i
Next i
in above code Step value will be 2, so i will increment by 2 for every iteration whether j is modifying inside loop or not, it will not impact Step value, so output will be
1 3 5 7 9
Please correct me if I miss anything or something is wrong in this. Also suggest if there is any way for dynamic looping using For loop in VBA.
I have a Excel matrix as below:
PID# T1 T2 T3 T4 T5 T6 T7
11 1 1
14 1 1 1
21 1 1
41 1 1 1 1
71 1
88 1 1 1
PID# is nothing but the processes, all the processes has been composed of multiple tasks. But it is not mandatory that all processes should use all the T1 - T5 tasks. In such a scenario is it possible to get the PID# which used maximum tasks. 1 used to indicate that a task has been used or not. here the PID# 41 and 88 used maximum tasks say it is 5. I need only the maximum used column count and any of the row# which used that number of columns.
NOTE
here i have used 1 to tell there is data,but in reality there are different types of data. I need to find out which row used maximum columns.But one thing if any cells for a row is blank and it is to the left,should be in the count. say for example --
<> 1 <> 1 gives the count as 4
<> <> 1 <> will give the count as 3
1 1 <> will give the count as 2 ' here I used <> used to represent the no values
EDIT
Option Explicit
Dim ArrayListTaskDetails : Set ArrayListTaskDetails = CreateObject("System.Collections.ArrayList")
Dim i,colcount
i=2
Do while i < = objExcel1.Application.WorksheetFunction.CountA(ob.Rows(1))
colcount=objExcel1.Application.WorksheetFunction.CountA(ob.Rows(i))
ArrayListTaskDetails.Add(colcount)
i=i+1
Loop
ArrayListTaskDetails.Sort()
i=ArrayListTaskDetails.Count
MsgBox("HighestColumnNumner:" & ArrayListTaskDetails(i-1))
Problem:
I can't count the blank columns for rows which don't have the contiguous value. Thus count is not produced by me correctly.
EDIT1
Here the problem is still i can't count the left blank cells if any,as those are also to be considered as used column,in which other rows can have values.Thus need to find out the the right most column which has been used by a row after which no columns has been used by any rows. Hope I am able to clear what I am looking for:
Option Explicit
Dim objExcel1
Dim strPathExcel1
Dim objSheet1,objWB,ColCount
Dim ArrayListTaskDetails : Set ArrayListTaskDetails = CreateObject("System.Collections.ArrayList")
Set objExcel1 = CreateObject("Excel.Application")
strPathExcel1 = "D:\AravoVB\.xlsx"
Set objWB = objExcel1.Workbooks.open(strPathExcel1)
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)
Do Untill count > objExcel1.Application.WorksheetFunction.CountA(objSheet1.Rows(1))
Range = objSheet1.("count:count")
ColCount=objExcel1.Application.WorksheetFunction.CountIf(Range,<> "")
ArrayListTaskDetails.Add(ColCount)
Loop
ArrayListTaskDetails.Sort()
MsgBox(ArrayListTaskDetails(ArrayListTaskDetails.Count - 1))
Thanks,
Still not convinced why Vikas answer is not working for you. Try this code please. It highlights the last max value. Only flaw is that it doesn't track all the PID that has same max value. I could improve the code if you need that as well.
Code:
Option Explicit
Sub getRealUsedColumns()
Dim rngInput As Range
Dim arrInput As Variant, arrRowTotal As Variant
Dim i As Integer, j As Integer, counter As Integer, iTemp As Integer
Dim iPID As Integer, maxRowNum As Integer
arrInput = Application.WorksheetFunction.Transpose(Sheets(3).Range("B3:I8").Value2)
ReDim arrRowTotal(LBound(arrInput, 2) To UBound(arrInput, 2))
For i = LBound(arrInput, 2) To UBound(arrInput, 2)
counter = 0
For j = LBound(arrInput) + 1 To UBound(arrInput)
If arrInput(j, i) <> "" Or Not IsEmpty(arrInput(j, i)) Then
counter = counter + 1
End If
Next j
'-- most recent max value (if you have two of the same, this doens't catch)
'-- you need to save in a proper array to catch multiple PIDs with same max value
If iTemp <= counter Then
iTemp = counter
iPID = arrInput(1, i)
maxRowNum = i
End If
arrRowTotal(i) = counter
Next i
'-- Row total into the sheet output
Sheets(3).Range("J3").Resize(UBound(arrRowTotal)) = _
Application.WorksheetFunction.Transpose(arrRowTotal)
'-- highlight the max total row.
With Sheets(3).Range("B3").Offset(maxRowNum - 1, 0).Resize(1, UBound(arrInput, 1) + 1)
.Interior.Color = 200
End With
End Sub
Results:
Excel is very powerful in calculating Matrix. I would use the Excel Formula instead of Code in order to calculate it. I would add a column in the right, which would add the total number of tasks used by a process, as shown in the matrix below.
A B C D E F G
1 PID T1 T2 T3 T4 T5 Total
2 #11 1 1
3 #14 1 1 1 3
4 #21 1 1 1 1 1 5
5 #41 1 1 2
Then I will write two Array Formulas to calculate the maximum number of tasks used by a process and the name of that process.
Formula to calculate maximum tasks used in the example: =SUM(IF($G$2:$G$5=MAX($G$2:$G$5),G2:G5,0))
Formula to find the pricess which used the maximum tasks:
=OFFSET(A1,SUM(IF($G$2:$G$5=MAX($G$2:$G$5),ROW(G2:G5)-1,0)),0,1,1)
Please note that I had mentioned that I used Array formulas. In order to add array formula in Excel, you need to enter formula and then press "Ctrl+Shift+Enter" to make that formula an array formula.
Hope this helps.
Vikas B
-----------------EDIT-----------------------------------------------------
Adding the code here. I just used the sample, as show in matrix and produced the correct result.
Sub FindMax()
'assuming column 1 is the task ID and Row one has the headings.
Const LastColumn As Integer = 7 ' you can use xl end to get the last used column in the range
Const LastRow As Integer = 5
Dim rowCounter As Integer
Dim prevValue As Integer
Dim rngToTotal As Range
Dim sht As Worksheet
Dim maxRowName As String
Dim value As Integer
Dim maxValue As Integer
Set sht = ActiveSheet
For rowCounter = 2 To LastRow
Set rngToTotal = sht.Range(sht.Cells(rowCounter, 2), sht.Cells(rowCounter, LastColumn))
value = WorksheetFunction.Sum(rngToTotal)
If value > prevValue Then
maxRowName = sht.Cells(rowCounter, 1).value
maxValue = value
End If
prevValue = value
Next rowCounter
MsgBox "Process name " & maxRowName & " = " & maxValue
End Sub