I have a table that can contain any number of rows:
As I said it can contain 1 or ā rows.
I want to sort range A3:Dā by the Date cell that is in column B.
How can I do it?
The problem is that I don't know how to select from A3 to the last row.
I think that looping to the last row is not a correct method.
I have got this so far it sorts looks like correct, but the range is hard-coded. How do I get rid of the hard-coding of the range?
Range("A3:D8").Sort key1:=Range("B3:B8"), _
order1:=xlAscending, Header:=xlNo
Try this code:
Dim lastrow As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A3:D" & lastrow).Sort key1:=Range("B3:B" & lastrow), _
order1:=xlAscending, Header:=xlNo
Or this:
Range("A2", Range("D" & Rows.Count).End(xlUp).Address).Sort Key1:=[b3], _
Order1:=xlAscending, Header:=xlYes
You can sort any range in a very dynamic way by using the SortRange and GetCurrentRegionStartingGivenCell function in Xatocode as follows:
' First you may define a worksheet level named range in cell "A2" and name it as rngData
Sub SortExample()
Dim rngData As Range ' Range to sort
Set rngData = GetCurrentRegionStartingGivenCell(shtData.Range("rngData"))
Call SortRange(rngData, True, 2, xlAscending, 3, xlDescending)
End Sub
You can read the complete article here
If the starting cell of the range and of the key is static, the solution can be very simple:
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort key1:=Range("B3", Range("B3").End(xlDown)), _
order1:=xlAscending, Header:=xlNo
Related
I want to do lookup in a specified range(rows X to AF in "main" tab[Sheet1]) which I am doing using VBA hlookup function. The problem I am facing is that I am not able to do this lookup in a loop, which means once the hlookup is done in X2:AF2, then it should do the calculation in X3:AF3 for next row.
I need to do this because the Tablehandle[sheeet2] result will change every time (macro will clear this sheet) and the headers will not in order.
So can someone help me to get hlookup in a loop for a specified row?
My "Main" sheet
"TableHandle" sheet
Option Explicit
Sub hlookup1()
Dim i, r As Long
For i = 1 To Range("K100000").End(xlUp).Row - 1
'first macro will get the table inside sheet ...
Sheets("TableHandle").Select
'Range("A2").Select
'Range(Selection, Selection.End(xlDown)).Select
'Range("A2:B10").Select
'Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'hlookup
Sheets("Main").Select
Range("X2").Select
Range("X" & i + 1).Select
ActiveCell.FormulaR1C1 = "=HLOOKUP(R1C,TableHandle!R1C6:R2C14,2,0)"
Selection.Copy
Range("X2:AF2").Select 'PROBLEM from Here, it will again calculate in x2 to af2 range)
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
i = i + 1
Next
End Sub
Yours is a good idea but in practice it has a number of drawbacks as demonstrated by the error handling you had planned. I think you would also have to replace the formulas you insert with so much effort with the values they produce. Please try this code instead. It transfers data from the TableHandler sheet to the Main without the use of worksheet formulas.
Sub hlookup1()
' 211
Dim Data As Variant ' source data
Dim Headers As Range ' column captions in 'Main'
Dim Fnd As Range ' Find the column caption
Dim Rs As Long ' Row: Source (= 'Data')
Dim Cs As Long ' Column: Source
Dim Rt As Long ' Row: Target
Dim Ct As Long ' Column: Target
'first macro will get the table inside sheet ...
With Worksheets("TableHandle") ' data source
Rs = .Cells(.Rows.Count, "A").End(xlUp).Row
Data = .Range(.Cells(2, "A"), .Cells(Rs, "X")).Value
' Row 1 of 'Data' holds the column headers because
' SheetRow(2) became the ArrayRow(1)
End With
Application.ScreenUpdating = False ' speed up execution
With Worksheets("Main")
Set Headers = .Range("A2:X2")
' start in array row 2 because array row 1 holds the column captions
For Rs = 2 To UBound(Data) ' loop through all rows
Rt = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
For Cs = 1 To UBound(Data, 2) ' loop through the columns of each row
Set Fnd = Headers.Find(Data(1, Cs), LookIn:=xlValues, lookat:=xlWhole)
If Not Fnd Is Nothing Then ' skip column not found
.Cells(Rt, Fnd.Column).Value = Data(Rs, Cs)
End If
Next Cs
Next Rs
End With
Application.ScreenUpdating = True
End Sub
If a column in the TableHandler should not be found the macro will not transfer data, leaving the target column blank. If you want a warning it would have to be added. There is a little confusion in your question as to rows and columns. Should I have guessed wrongly here or there I trust you will be able to make the required modifications. However, you are welcome to ask for help, too.
it was important and i spent all day to make this possible, i ans my question here.
the code is shortned as below, it works fast and efficient. thanks for suggestions!
Dim Hlookp As Variant
Hlookp = Application.HLookup(Range("B1:J1").Value, Sheets("TableHandle").Range("F1:N" & Cells(Rows.Count, 1).End(xlUp).row), 2, False)
Range("B" & i + 1 & ":J" & i + 1).Value = Hlookp
I am trying to copy the formula from a cell in column C straight across to column F. I always want to copy the formula from column C and drag through column F, however the row should be determined by the active cell. Once the formula is dragged across I want to drag those formulas down to the last row with data in column B.
So far my VBA from my recorded macro looks like this:
ActiveCell.FormulaR1C1 = _
"=INDEX('Item Setup'!C2:C40,MATCH(R[-8]C2,'Item Setup'!C2,0),MATCH(R4C,'Item Setup'!R4C2:R4C40,0))"
Range("C13").Select
Selection.AutoFill Destination:=Range("C13:F13"), Type:=xlFillDefault
Dim lastRow As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
Range("C13:F13").AutoFill Destination:=Range("C13:F" & lastRow)
Range("C13:F13").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Think you can do this in one go, and also without having to use Select or Autofill.
Not generally advisable though to base a macro on the active cell.
Sub x()
Dim lastRow As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
With Range(Cells(ActiveCell.Row, "C"), Cells(lastRow, "F"))
.FormulaR1C1 = _
"=INDEX('Item Setup'!C2:C40,MATCH(R[-8]C2,'Item Setup'!C2,0),MATCH(R4C,'Item Setup'!R4C2:R4C40,0))"
.Value = .Value
End With
End Sub
First, stay away from ActiveCell, Selection and Select, instead use fully qualified Range and Worksheet objects.
Second, you can set your entire range where you want to add your formula, and then fill it at once, without dragging or anything like it.
Modified Code
Dim Sht As Worksheet
Dim AnchorRng As Range
Dim LastRow As Long
Set Sht = ThisWorkbook.Sheets("YourSheetName") ' modify with your sheet's name
With Sht
Set AnchorRng = ActiveCell ' .Range("C13") ' start point of your formula
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row ' get last row in column B
.Range(AnchorRng, .Cells(LastRow, "F")).FormulaR1C1 = _
"=INDEX('Item Setup'!C2:C40,MATCH(R[-8]C2,'Item Setup'!C2,0),MATCH(R4C,'Item Setup'!R4C2:R4C40,0))"
End With
Note: this code is not debugging your formula, just assigning to your entire range.
I'm trying to write code which automates something: I've got a table of data which I need to add a column into, then put a sum in which goes all the way down to the bottom row of data and no further. I know how to define the bottom row as a variable; but what if the column I'm entering the data can vary too? In my example, the column I want to do the sums in is always to the left of the column entitled '16'. It will always start at row 2, but it won't always be column O. It might be column P, or Q, for example.
Sub enter_column_and_add_calculations()
Dim NBottomrow
Call find_bottom_row
NBottomrow = ActiveCell.Row
'find column entitled '16':
Range("A1").Select
Cells.Find(What:="16", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
'insert new column to the left:
Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
'insert text in the cell:
ActiveCell.FormulaR1C1 = "OOT Debt"
'offset one cell below:
ActiveCell.Offset(1, 0).Range("A1").Select
'i'm now in the cell i want my range to start at. In this example it's cell O2, but it often varies:
ActiveCell.FormulaR1C1 = "=SUM(RC[1]:RC[5])"
Selection.AutoFill Destination:=Range("O2:O" & NBottomrow)
End Sub
Private Sub find_bottom_row()
Range("A1").Select
Selection.End(xlDown).Select
End Sub
Many thanks for your help :-)
Try,
Sub enter_column_and_add_calculations()
dim m as variant, lr as long
with worksheets("sheet1")
m = application.match(16, .rows(1), 0)
if iserror(m) then exit sub
lr = .cells(.rows.count, m).end(xlup).row
.cells(lr+1, m).formula = "=sum(" & .range(.cells(2, m), .cells(lr, m)).address(0,0) & ")"
end with
end sub
I've been struggling for several hours to set row heights for an implied range. The code works except for two problems 1. ALL rows with data are set to AutoFit instead of just the intended range and 2. I cannot seem to add '3' to the row height per the 2nd to last line of code:
Sub SetRH()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("C" & (ActiveCell.row)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection.Offset(0, 0), Selection.Offset(0, 4)).Select
Selection.sort Key1:=Range("C6"), Order1:=xlAscending, Key2:=Range("E6") _
, Order2:=xlAscending, Key3:=Range("D6"), Order3:=xlAscending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For Each row In ActiveSheet.UsedRange.Rows: Rows.AutoFit: Next
For Each row In ActiveSheet.UsedRange.Rows: Rows.RowHeight = Rows.RowHeight + 3: Next
Application.ScreenUpdating = True
End Sub
Any help is much appreciated!
The below code will loop through each row auto fit and then increase the row height by +3.
Dim ws As Worksheet
Set ws = ActiveSheet
Dim Rng As Range
Dim cel As Range
Set Rng = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp))
For Each cel In Rng
cel.Rows.AutoFit
cel.Rows.RowHeight = cel.Rows.RowHeight + 3
Next cel
I wrote a macro some time ago to search for values from one spreadsheet (Data) on another spreadsheet (Sheet1), then pull the value from the cell 2 columns to the left of where the result was found on Sheet1. It was working great, but something seems to have changed(???) and it's now returning all "False" results, despite the fact that the values certainly exist in both spreadsheets.
It searches for the values in Column C on the first worksheet on the second sheet (always called Sheet1)
I can provide the spreadsheets in question for any testing.
My annotated code is below, any help would be greatly appreciated:
Sub GroupFileNameFix()
'
' GroupFileNameFix Macro
'define variable types
Dim strFormula As Variant
Dim LastRow As Long
'on Data sheet
With ActiveSheet
' determines last row on spreadsheet and saves value to variable "LastRow"
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'sets variable "strFormula" as what we want to autofill, grabbing group filenames
strFormula = "=IFERROR(INDEX(Sheet1!RC[-3],(MATCH(RC[1],Sheet1!C[-1],0))),""False"")"
'inserts column "GroupFileName" as column D
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D1").Select
ActiveCell.FormulaR1C1 = "GroupFileName"
Columns("D:D").EntireColumn.AutoFit
' Fills cell D2 and then autofills column D to end of spreadsheet
Range("D2:D2").Select
.Range("D2:D2").Formula = strFormula
.Range("D2:D" & LastRow).FillDown
End With
'Commit formula to text and replace "png" with "jpg"
Columns("D:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="png", Replacement:="jpg", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Based on your code, since you are always putting the formula in the same column, this worked for me.
With ActiveSheet
strFormula = "=IFERROR(INDEX(Sheet1!A2,(MATCH(E2,Sheet1!C:C,0))),""False"")"
'inserts column "GroupFileName" as column D
Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D1").Value = "GroupFileName"
Columns("D:D").EntireColumn.AutoFit
' Fills cell D2 and then autofills column D to end of spreadsheet
.Range("D2").Formula = strFormula
.Range("D2:D" & LastRow).FillDown
End With
Wow, so this ended up being a lot simpler than I was making it. I got caught up in trying to automate this with a macro, when a simple paste formula & autofill workflow is just as easy. The formula below works perfectly.
=IFERROR(INDEX(Sheet1!A$2:A$2000,(MATCH($C2,Sheet1!C$2:C$2000,0))),"False")