I would like to use some macro to populate cells with the formula subtotal(9,"range"), being the range dinamic, based on the lenght of the cell.
sample
I need to populate in row "C" the formula subtotal(9;range) based on the values in column "B".
It have to check the value on column B, and compare to the row below. If the value of the row below is equal or inferior, it must be "blank", if not, will create a formula =subtotal(9,range), the range will start the row below and go until find a lenght equal or inferior.
I do this manual, but sometimes i have more than 1000 rows.
Many thanks.
In the question you mention to populate the row with the subtotal function only if current row is inferior or equal to next row, but in your sample you only populate when is inferior. So I coded it that way. It can be changed by replacing the > in If .Range("B" & next_row) > .Range("B" & r) Then to >=
Sub populate()
Dim r As Long, r2 As Long, last_row As Long
Dim next_row As Long, current_len As Long, test_len As Long
Dim rng As String
With ActiveSheet
last_row = .Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To last_row
next_row = r + 1
If .Range("B" & next_row) > .Range("B" & r) Then
current_len = .Range("B" & r)
'create range
For r2 = r + 1 To last_row
test_len = .Range("B" & r2)
If current_len >= test_len Then
rng = "C" & r + 1 & ":" & "C" & r2 - 1
Exit For
End If
Next
.Range("C" & r).Formula = "=SUBTOTAL(9," & rng & ")"
End If
Next
End With
End Sub
Related
I'm trying to sum a number of columns together in a new column.
I have been able to get to the point where I take A+B and place the values in C. However, the actual columns I will need to sum vary. Is there a way I can edit my code so that any selected columns can be summed in a new column to the right of the selection?
For example. If I select columns B-D, it would insert a new column in E that houses the sums of columns B,C, and D. Or if I selected E-F, it would insert a new column in G that houses the sums of columns E and F.
Sub SumColumns()
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row
For i = 1 To Lastrow
Range("C" & i).Value = Range("A" & i).Value + Range("B" & i).Value
Next i
End Sub
Here is my (rather sloppy) solution:
Sub Test()
Dim col1 As String, col2 As String, lastrow As Long
col1 = Split(Selection.Address, "$")(1)
col2 = Split(Selection.Address, "$")(3)
lastrow = Cells(Rows.Count, col2).End(xlUp).Row
Columns(col2 & ":" & col2).Offset(0, 1).Insert Shift:=xlToRight
For i = 1 To lastrow
Range(col2 & i).Offset(0, 1).Value = WorksheetFunction.Sum(Range(col1 & i & ":" & col2 & i))
Next i
End Sub
I say this is sloppy, because if you have the entire column selected, you won't Split out the column values appropriately. So it depends on how you're trying to do this.
This procedure will let you select any range. It will add a column at the end of the range and sum each row to the new column.
Sub test()
Call InsertSumCol(Sheet1.Range("B2:E4"))
Call InsertSumCol(Sheet2.Range("E1:F3"))
End Sub
Private Sub InsertSumCol(ByVal oRange As Range)
'Add Sum Column to end of Range
oRange.Worksheet.Columns(oRange.Column + oRange.Columns.Count).Insert shift:=xlToRight
' Sum Each Row in Range
Dim oRow As Range
For Each oRow In oRange.Rows
oRow.Cells(1, oRow.Columns.Count + 1) = WorksheetFunction.Sum(oRow)
Next
End Sub
I assume that you want to sum vertically all cells in a row starting from column A.
Try this (some tips and comments are in code):
'use this in order to avoid errors
Option Explicit
Sub SumColumns()
'always declare variables!
Dim LastRow As Long, i As Long, ws As Worksheet, lastCol As Long, firstCol As Long
'if you can, avoid using ActiveSheet, Selection, etc. it's prone to errors
Set ws = ActiveSheet
i = 1
Do
firstCol = ws.Cells(i, 1).End(xlToRight).Column
lastCol = ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column
'there isn't any filled cells in a row
If lastCol = 1 Then Exit Do
ws.Cells(i, lastCol + 1).Value = Application.WorksheetFunction.Sum(ws.Range(ws.Cells(i, firstCol), ws.Cells(i, lastCol)))
i = i + 1
Loop While True
End Sub
Before and after:
I am trying delete all rows where column B to AD (Lastrow) are blank. On my excel sheet every couple of rows or so column B to AD are blank so i am trying to delete those rows. I have been trying to use the below code:
Sub T()
Dim rng As Range
Set rng = Range("B1:AC10402")
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
No success
Try this code:
Sub DeleteBlankRows()
Dim i As Long
Dim lastRow As Long: lastRow = 10 'here you have to specify last row your table uses
For i = lastRow To 1 Step -1
If Cells(i, Columns.Count).End(xlToLeft).Column = 1 Then
Rows(i).Delete
End If
Next i
End Sub
Little explanation
You specified that you need check for emptiness within row, columns B through AD. This piece of code Cells(i, Columns.Count).End(xlToLeft).Column will return column of the right-most (starting from first column), non-empty cell. If whole row is empty or there's data in first column - it will return 1 - which is misleading, when you are considering A cloumn. But it isn't here, since we consider columns starting with B. So if it returns 1, it means that the row is empty and should be deleted.
this deletes all blank rows in column B
Dim LastRow, i As Integer
LastRow = activesheet.Cells(activesheet.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 1 Step -1
If WorksheetFunction.CountA(Range("B" & i)) = 0 Then
Range("B" & i).EntireRow.Delete
End If
Next i
this deletes all blank rows if column B to column AC is blank
Dim LastRow, i As Integer
LastRow = activesheet.Cells(activesheet.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 1 Step -1
If WorksheetFunction.CountA(Range("B" & i & ":" & "AC" & i)) = 0 Then
Range("B" & i & ":" & "AC" & i).EntireRow.Delete
End If
Next i
I created a code to select and paste data from one sheet to another. But this code is always selecting last three values in row.
I need to select the data based on given range. Eg C5:C15 not for the entire c column. Help me
Private Sub CommandButton1_Click()
Dim LastRow1, LastRow2, LastRow3 As Long
Dim Last3Rows1, Last3Rows2, Last3Rows3 As Range
LastRow3 = Sheets("AVG-PO").Range("C" & Rows.Count).End(xlUp).Row
LastRow1 = Sheets("AVG-PO").Range("A" & LastRow3).End(xlUp).Row
LastRow2 = Sheets("AVG-PO").Range("B" & LastRow3).End(xlUp).Row
Set Last3Rows3 = Sheets("AVG-PO").Range("C" & LastRow3).Offset(-2, 0).Resize(3, 1)
Set Last3Rows1 = Sheets("AVG-PO").Range("A" & LastRow3).Offset(-2, 0).Resize(3, 1)
Set Last3Rows2 = Sheets("AVG-PO").Range("B" & LastRow3).Offset(-2, 0).Resize(3, 1)
Last3Rows1.Select
Selection.Copy Sheets("Data").Range("A30")
Last3Rows2.Select
Selection.Copy Sheets("Data").Range("B30")
Last3Rows3.Select
Selection.Copy Sheets("Data").Range("C30")
End Sub
Not sure i quite understand what range you want but you might be able to use this.
Sub test()
Dim NextFree As Long
Dim TableStartRange As Long
For i = 1 To 100
Select Case Range("A" & i).Value
Case "Table1"
TableStartRange = i + 1 'finds table1 in A2 and then +1 before the actual table start in column C
End Select
NextFree = Range("C" & TableStartRange & ":C" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row ' returns the value 14 since its the first free row in column C
End Sub
Having trouble with this code. No errors but also doesn't seem to do anything.
In my sheet, column "M" has some values that start with the letter "T" I want to select the entire row for these. Thanks in advance.
Sub trace1()
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Left(Range("M" & i).Value, 1) = trace Then Rows("i:i").Select
Next i
End Sub
One possible way to answer the question as written:
Sub trace1()
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
Dim SelectedRows As Range
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Not SelectedRows Is Nothing Then
If Left(Range("M" & i).Value, 1) = trace Then Set SelectedRows = Union(SelectedRows, Rows(i))
Else
If Left(Range("M" & i).Value, 1) = trace Then Set SelectedRows = Rows(i)
End If
Next i
SelectedRows.Select 'Replace with .Copy if that's what you really wanted.
End Sub
If you are trying to select the row assigned to variable "i", you would use:
Sub trace1()
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Left(Range("M" & i).Value, 1) = trace Then Rows(i).Select
Next i
End Sub
"Rows("i:i")" won't work. Try collecting all the addresses of all ranges in one string and then selecting the string. Note the comma which separates each range.
Sub trace1()
Dim sRange As String
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Left(Range("M" & i).Value, 1) = trace Then sRange = sRange & "," & i & ":" & i
Next i
Range(Mid(sRange, 2)).Select
End Sub
using AutoFilter to give you the range as is, or the actual address
avoids slow loops
Sub trace2()
Dim strTrace As String
Dim strAddress
Dim rng1 As Range
strTrace = "T"
Set rng1 = Range([m1], Cells(Rows.Count, "M").End(xlUp))
With rng1
.AutoFilter 1, strTrace & "*"
Set rng1 = rng1.Cells(1).Offset(1, 0).Resize(rng1.Rows.Count - 1, 1)
strAddress = rng1.SpecialCells(xlVisible).EntireRow.Address
End With
MsgBox "rows that start with " & strTrace & vbNewLine & strAddress
ActiveSheet.AutoFilterMode = False
End Sub
The expression
Rows("i:i").Select
throws an error -- Rows() won't recognize the text value "i:i" as an argument.
Rows(i).Select
will work. But it won't DO anything you can see, other than the last row should be selected when the code is finished running. You may want to do whatever needs to be done to the "T" rows at the next step in your code before your get to the Next i step.
EDIT:
OK, you want multiple rows selected when the code is finished. That can be done:
Dim RowsDescript As String
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Left(Range("M" & i).Value, 1) = trace Then RowsDescript = RowsDescript & i & ":" & i & ","
Next i
If Len(RowsDescript) > 0 Then
RowsDescript = Left(RowsDescript, Len(RowsDescript) - 1) ' removes the last comma
Range(RowsDescript).Select
End If
What you want to end up with is an expression that looks like this:
Range("9:9,12:12,16:16").Select
How you get there is, when a row is identified as having the "T" that you want in it, add the row number and a colon and the row number again and a comma to the string RowDescript. So at the end of the loop, you end up with the string having
9:9,12:12,16:16,
in it. But we need to strip off that last comma, so there's the check for a non-zero length string, remove the last character, and then select those rows.
1."T" is not equal to "t", to remove "case sensitivity" it is required to use LCase or UCase (low case or upper case)
2.Rows("i:i") replaced by Row(i)
Sub trace1()
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If UCase(Left(Range("M" & i).Value, 1)) = UCase(trace) Then Rows(i).Select
Next i
End Sub
And also one comment, at the final will be selected only last row in range, for example row 1,5 and 10 will start from "T", so at the end will be selected only 10th row
updated against question in the comments
this will allow you to select rows which starting from "t" or "T", but this method allow to select not more than 45 rows.
Sub Macro1()
Dim trace$, LR&, i&, Rng$
trace = "T": Rng = ""
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If UCase(Left(Range("M" & i).Value, 1)) = UCase(trace) Then Rng = Rng & i & ":" & i & ","
Next i
Rng = Left(Rng, Len(Rng) - 1)
Range(Rng).Select
End Sub
Use copy/paste one by one row if you need copy rows from one sheet to another, or sort range and select range from first row to the last row where cell value start from "T"
I need help on macros in Excel. I have a table in Excel (example attached).
I need columns A, E and G from source sheet, after last row i need A,E and H , after last row A,E and I and so on. Means Column A and E will be constant, only third column will change until column K.
In vertical manner.
Source data:
A B C D E F G H I J K
NAME AGE CITY STATE COUNTRY CODE PART DUEDATE VEND COMM QTY
Target:
A E G
A E H
A E I
A E J
A E K
EDIT: Code I am trying:
Sub Mosaic()
With ws
'Get the last row and last column
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
With ws2
'Get the last row and last column
lRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
lCol2 = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
'Save the range from A1:Alastrow and E1:Elastrow and store as variable
Set aRng = ws.Range("A1" & lRow)
Set aRng2 = ws.Range("E1" & lRow)
'Union(AE range and G1:Glastrow)
Set gRng = ws.Range("G1" & lRow)
Set hRng = ws.Range("H1" & lRow)
Set uRng = Union(aRng, aRng2, gRng)
uRng.Copy
ws2.Range("A" & lRow2).PasteSpecial
End Sub
Finding last rows: Excel VBA select range at last row and column
Find the last row of data on source sheet and store as variable.
Save the range from A1:Alastrow and E1:Elastrow and store as variable (since we need it three times)
Union(AE range and G1:Glastrow)
Copy / Paste
Union(AE range and H1:Hlastrow)
Copy
Find destination last row
Paste destination last row + 1
Repeat for all I, J, and K
You can write your own code from the help file provided
Edit: The fix for your code:
Sub Mosaic()
Dim aRng, eRng, extraRng as Range
Dim lRow, lRow2, CurCol as Long
With ws
'Get the last row and last column
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
'Save the range from A1:Alastrow and E1:Elastrow and store as variable
Set aRng = ws.Range("A1:A" & lRow)
Set aRng2 = ws.Range("E1:E" & lRow)
For CurCol = 7 to 11 'Cols G (7) to K (11)
Set extraRng = ws.Range(Cells(2, CurCol),Cells(lRow, CurCol))
'Always get the lRow2 right before pasting to ensure you have the last row.
'Get the last row of destination sheet
lRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row + 1
aRng.Copy
ws2.Range("A" & lRow2).PasteSpecial
eRng.Copy
ws2.Range("B" & lRow2).PasteSpecial
extraRng.Copy
ws2.Range("C" & lRow2).PasteSpecial
Next CurCol
End Sub