I've already used Set to create ranges with names in the format rng1a. I then use a loop to go through i (integer) values, and want to set the final range to use to be the one that has the name in the form 'rng' & i & "a"
My initial thought was something along the lines of Range("rng" & i & "a"), however this results in an error.
Set rng1a = Range("B2", Range("B2").End(xlDown))
Set rng2a = Range("D2", Range("E2").End(xlDown))
i = 1
Do
("rng" & i & "a").Copy 'this is the problem
Range("A2").End(xlDown).Offset(1,0).PasteSpecial xlPasteValues
i = i + 1
Loop Until i = 3
I keep getting an error message with
run-time error '1004':
Method 'Range' of object '_Global' failed
My thought is that I need to format the name of the range as a string so that it can be recognised as the name of a range. Is there a way to do this?
I haven't tested either of these, but I think they should work.
Be wary of using End(xldown) as if you don't have anything underneath the first cell you will go straight to the very last cell. Better to work up from the bottom (see Damian's answer).
Sub x1()
'Array
Dim rng(1 To 2) As Range, i As Long
Set rng(1) = Range("B2", Range("B2").End(xlDown))
Set rng(2) = Range("D2", Range("E2").End(xlDown))
For i = 1 To 2
rng(i).Copy
Range("A2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Next i
End Sub
Sub x2()
'Named ranges
Dim i As Long
Range("B2", Range("B2").End(xlDown)).Name = "rng1a"
Range("D2", Range("E2").End(xlDown)).Name = "rng2a"
For i = 1 To 2
Range("rng" & i & "a").Copy
Range("A2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Next i
End Sub
This should do it:
Option Explicit
Sub Test()
Dim i As Long, LastRow As Long
Dim arrRanges(1 To 2) As Range
With ThisWorkbook.Sheets("NameYourSheet") 'change the sheet name
Set arrRanges(1) = .Range("B2", .Range("B2").End(xlDown))
Set arrRanges(2) = .Range("D2", .Range("E2").End(xlDown))
For i = LBound(arrRanges) To UBound(arrRanges)
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
arrRanges(i).Copy .Range("A" & LastRow)
Next i
End With
End Sub
Remember to always declare all your variables, and reference to workbooks and worksheets.
What you actually want to do (I think) is copy the contents of the columns B,C D etc, into Column A underneath each other.
Sub CopyStuff
Dim i as integer
dim r as range
for i = 1 to 6
set r = range(cells(1,i),cells(1,i).end(xldown))
r.copy
range("a1").end(xldown).offset(1,0).pastespecial xlpastevalues
next i
End sub
You can have array of ranges :
Set rng1a = Range("B2", Range("B2").End(xlDown))
Set rng2a = Range("D2", Range("E2").End(xlDown))
For Each rng in Array(rng1a, rng2a)
rng.Copy
Range("A2").End(xlDown).Offset(1,0).PasteSpecial xlPasteValues
Next
Related
I'm a beginner. Just learning by Googleing, but cannot find a solution for this. Please help.
I want to run the below macro.
I have multiple cells named "CV_=CVCAL" in the same column.
What I want is for the macro to find the first cell with the value "CV_=CVCAL" and offset to the adjacent cell. If the adjacent cell has a particular value, if the value is below lets say "1.5" i want to fill it will a cell style 'bad'.
I want the macro to go through all the cells that have the name CV_=CVCAL and do the same thing until there is no more cells named CV_=CVCAL.
Sub If_CV()
Range("A1").Select
Set FoundItem = Range("C1:C1000").Find("CV_=CVCAL")
FoundItem.Offset(columnOffset:=1).Select
If ActiveCell.Value >= 1.5 Then
ActiveCell.Style = "Bad"
End If
End Sub
Sounds like you want to loop through your values.
Determine the end of your range
Loop through your range and check your criteria
Sub If_CV()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long, i As Long
lr = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
For i = 2 To lr
If ws.Range("C" & i) = "CV_=CVCAL" Then
If ws.Range("D" & i) >= 1.5 Then
ws.Range("D" & i) = "Bad"
End If
End If
Next i
End Sub
A basic loop would be simpler:
Sub If_CV()
Dim c As Range, ws As Worksheet
For Each ws in ActiveWorkbook.Worksheets
For Each c in ws.Range("C1:C1000").Cells
If c.Value = "CV_=CVCAL" Then
With c.offset(0, 1)
If .Value >= 1.5 Then .Style = "Bad"
End With
End If
Next ws
Next c
End Sub
How do I get the position of the last non-empty cell in a filtered column without dropping the applied Autofilter? I understand it's easy to get the number of the last visible row with
Dim ws as Worksheet, rng As Range
Set rng = Range(Letter & 1 & ":" & Letter & 1) ' where Letter is the letter code of the column
GetLastVisibleRow = ws.Range(Split(ws.Cells(, rng.Column).Address, "$")(1) & ws.Rows.count).End(xlUp).row
but I need the number of the last filled row instead. At the same time, I'd like to avoid setting
ws.AutoFilterMode = False
if it's possible.
Thanks in advance.
Probably not the most efficient or fastest method, but this appears to work:
Function GetLastCellOfColumn(ColLetter As String) As Range
Dim Col As Range
Dim Rw As Long
Set Col = Range(ColLetter & ":" & ColLetter)
Set GetLastCellOfColumn = Intersect(ActiveSheet.UsedRange, Col)
For Rw = GetLastCellOfColumn.Cells.Count To 1 Step -1
If Len(GetLastCellOfColumn.Cells(Rw).Value) > 0 Then
Set GetLastCellOfColumn = GetLastCellOfColumn.Cells(Rw)
Exit Function
End If
Next
End Function
A charming solution by #jkpieterse plus a useful comment by #BigBen is exactly what I was looking for. Just to finalize the thread, the function returning the row number is
Function GetLastFilledCellOfColumn(ws As Worksheet, ColLetter As String) As Long
Dim Col As Range, Urng As Range, Rw As Long
Set Col = ws.Range(ColLetter & ":" & ColLetter)
Set Urng = Intersect(ws.UsedRange, Col)
For Rw = Urng.Cells.count To 1 Step -1
If Not IsEmpty(Urng.Cells(Rw)) Then
GetLastFilledCellOfColumn = Rw
Exit Function
End If
Next
End Function
Problem solved.
So maybe this is an alternative way to look into:
Sub Test()
Dim rng As Range
Dim col As Long: col = 2 'Change to whichever column you interested in
Dim rw as Long
With Sheet1 'Change to whichever sheets CodeName you need
Set rng = .Range("_FilterDatabase").Columns(col)
rw = .Evaluate("MAX(IF(" & rng.Address & "<>"""",ROW(" & rng.Address & ")))")
End With
End Sub
I'm afraid I rushed this a little and might have made a mistake but will have to get going. Hopefully you understand whats going on =)
Edit:
The above would definately work, but as figured out through the chat, there is actually a ListObject involved, called Table1, which throws of the AutoFilter range. So here are two alternative ways of doing the same thing:
Sub Test()
Dim rng As Range
Dim col As Long: col = 2 'Change to whichever column you interested in
Dim rw as Long
With Sheet1 'Change to whichever sheets CodeName you need
Set rng = .Range("Table1")
rw = .Evaluate("MAX(IF(" & rng.Address & "<>"""",ROW(" & rng.Address & ")))")
End With
End Sub
Or, when you don't know the name of the table:
Sub Test()
Dim rng As Range
Dim col As Long: col = 2 'Change to whichever column you interested in
Dim rw as Long
With Sheet1 'Change to whichever sheets CodeName you need
Set rng = .ListObjects(1).Range
rw = .Evaluate("MAX(IF(" & rng.Address & "<>"""",ROW(" & rng.Address & ")))")
End With
End Sub
I have an Excel file with information in column A and column B. Since these columns could vary in the number of rows I would like to use the function offset so that I could print the formula in one time as an array rather than looping over the formula per cell (the dataset contains almost 1 million datapoints).
My code is actually working the way I want it to be I only can't figure out how to print the code in Range(D1:D5). The outcome is now printed in Range(D1:H1). Anybody familiar how to use this offset within a for statement?
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set example = Range("A1:A1")
For i = 1 To LastRow
example.Offset(0, i + 2).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
End Sub
Using the Offset(Row, Column), you want to offset with the increment of row (i -1), and 3 columns to the right (from column "A" to column "D")
Try the modified code below:
Set example = Range("A1")
For i = 1 To LastRow
example.Offset(i - 1, 3).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
One way of outputting the formula in one step, without looping, to the entire range, is to use the R1C1 notation:
Edit: Code modified to properly qualify worksheet references
Option Explicit
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
With sht
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set example = .Range(.Cells(1, 1), .Cells(LastRow, 1))
End With
example.Offset(columnoffset:=3).FormulaR1C1 = "=sum(rc[-3],rc[-2])"
End Sub
You don't need to use VBA for this. Simply type =sum(A1:B1) in cell D1 and then fill it down.
If you're going to use VBA anyway, use this:
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set example = Range("A1:A1")
For i = 1 To LastRow
example.Offset(i - 1, 3).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
End Sub
The way offset works is with row offset, column offset. You want the column to always be fixed at 3 to the right.
I'm trying to make a program in the Excel VBA that inserts a formula into a column of cells. This formula changes based on the contents of the cell directly to the left.
This is the code I have written so far:
Sub Formula()
Dim colvar As Integer
colvar = 1
Dim Name As String
Name = "Sample, J."
Do While colvar <= 26
colvar = colvar + 1
Name = Range("B" & colvar).Value
Range("C" & colvar).Value = "='" & Name & "'!N18"
Loop
End Sub
As you can see, I want to insert the variable Name between the formula strings, but Excel refuses to run the code, giving me a "application-defined or object-defined error."
Is there a way to fix this?
You will need some error checking in case the sheets don't actually exist in the workbook.
it looks like you are looping through column B that has a list of sheet names and want range N18 to display next to it.
Something like
Sub Button1_Click()
Dim Lstrw As Long, rng As Range, c As Range
Dim Name As String
Lstrw = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B1:B" & Lstrw)
For Each c In rng.Cells
Name = c
c.Offset(, 1) = "='" & Name & "'!N18"
Next c
End Sub
Or you can just list the sheets and show N18 next to it, run this code in a Sheet named "Sheet1"
Sub GetTheSh()
Dim sh As Worksheet, ws As Worksheet
Set ws = Sheets("Sheet1")
For Each sh In Sheets
If sh.Name <> ws.Name Then
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1) = sh.Name
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(0, 1) = sh.Range("N18")
End If
Next sh
End Sub
Thank you to everyone for your help! I actually found that I had just made a silly error: the line Do While colvar<=26 should have been Do While colvar<26. The cells were being filled, but the error manifested because one cell was being filled by a nonexistent object.
I did decide to use the .Formula modifier rather than .Value. Thank you to Jeeped for suggesting that.
I pasted the entire macro below but this is the important part.
Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value
Range("D2:D10000").Value = Range("D2").Offset(-1, 1).Value
Range("F2:F10000").Value = Range("F2").Offset(-1, 1).Value
Range("H2:H10000").Value = Range("H2").Offset(-1, 1).Value
It works as is except it is creating unnecessary data because I don't know how to use variable names in a range object. My ranges are currently hard coded such as ("A1:A1000"), when I would like it to be something like ("A1:A & LastRow).
Also I have to explicitly call out column names to copy because the range won't accept a variable name like ("currentColumn & 1:currentColumn & LastRow).
Is there a way to use a varible name as part of a range object so we can use them in loops?
Sub prepareWorkbook()
Dim wbk As Workbook
Set wbk = ThisWorkbook
Dim wks As Worksheet
Set wks = wbk.ActiveSheet
Dim colx As Long
Dim ColumnCount As Long
Dim MySheetName As String
MySheetName = "Import"
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
ActiveSheet.Name = MySheetName
'identify the Id column and move it to 1st column
Dim answer As Variant
Dim IdColumn As Range
answer = Application.InputBox("Enter Letter of Id column")
If Columns(answer).Column = 1 Then
Else
'cut Id column from current location and insert it at column index 1
Columns(answer).Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
End If
'trim the PartNumber column of any trailing spaces
Dim c As Range
For Each c In Range("A1:A10000")
c.Value = Application.Trim(Replace(c.Value, Chr(160), Chr(32)))
Next
' insert column every other column
' Loop through number of columns.
ColumnCount = Application.WorksheetFunction.CountA(Rows(1)) * 2
'step 2 means skip every other
For colx = 2 To ColumnCount Step 2
Columns(colx).Insert Shift:=xlToRight
Next
Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value
Range("D2:D10000").Value = Range("D2").Offset(-1, 1).Value
Range("F2:F10000").Value = Range("F2").Offset(-1, 1).Value
Range("H2:H10000").Value = Range("H2").Offset(-1, 1).Value
wks.Cells.EntireColumn.AutoFit
MsgBox ("Done")
End Sub
Assuming the you are running code in the Worksheet added here:
'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
ActiveSheet.Name = MySheetName
Also not sure what is the purpose of this code, nevertheless using it for the sample
Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value
Try this:
Dim lLastRow As Long
lLastRow = wbk.Worksheets(MySheetName).UsedRange.SpecialCells(xlLastCell).Row
Rem This updates only columns B, D, F & H - adjust as needed
For colx = 2 To 8 Step 2
With wbk.Worksheets(MySheetName)
Rem Creates Range as Range(Cells(rIni,cIini), Cells(rEnd,cEnd))
rem Corresponding code for "Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value" (see comment above)
Range(.Cells(2, colx), .Cells(lLastRow, colx)) = .Cells(2, colx).Offset(-1, 1).Value
End With: Next
Something like:
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("B2:B" & LastRow).Value = Range("B2").Offset(-1, 1).Value
Range("D2:D" & LastRow).Value = Range("D2").Offset(-1, 1).Value
Range("F2:F" & LastRow).Value = Range("F2").Offset(-1, 1).Value
Range("H2:H" & LastRow).Value = Range("H2").Offset(-1, 1).Value
Although this answer won't be applied to your situation, I feel like this could help answer some questions you have in there.
When specifying a range, you can separate the column (letter) and row (number) and use your own variables.
In a for loop, this could look like
for i = 1 to 100
Range("A" & i).Value = Range("A"&i).Offset(, 1).Value
next
You can also determine the number of the row of the selected cell using:
dim RowNb as long
RowNb = (ActiveCell.Row)
This also applies to columns, and can be used in a loop like I mentionned at the start.
The one thing that was conspicuous by its absence in your description was any mention of the nature of the data in the worksheet. You mentioned A1 briefly but your range value assignments started at row 2 so it may be inferred that row 1 contains column header labels.
Sub prepareWorkbook()
Dim wbk As Workbook, wks As Worksheet
Dim colx As Long
Dim lc As Long, lr As Long
Dim MySheetName As String
Set wbk = ThisWorkbook 'no idea what this does
Set wks = wbk.ActiveSheet 'no idea what this does
MySheetName = "Import"
'no idea what this does or what sht is
'LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
With Sheets(2)
.Name = MySheetName
If CBool(Application.CountIf(.Rows(1), "PartNumber")) Then
colx = Application.Match("PartNumber", .Rows(1), 0)
Else
colx = .Range(Application.InputBox("Enter Letter of Id column") & 1).Column
End If
If .Columns(colx).Column > 1 Then
'cut Id column from current location and insert it at column index 1
.Columns(colx).Cut
.Columns(1).Insert Shift:=xlToRight
End If
'quickest way to trim trailing spaces is with Text-to-Columns, Fixed Width
With .Columns(1)
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
End With
' insert column every other column (working backwards toward A1)
For lc = .Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
.Columns(lc).Insert Shift:=xlToRight
Next lc
For lc = (.Cells(1, Columns.Count).End(xlToLeft).Column - 1) To 2 Step -2
'let's put the row-by-row value in instead of a single value into all cells
lr = .Cells(Rows.Count, lc + 1).End(xlUp).Row
With .Cells(2, lc).Resize(lr - 1, 1)
.Cells = .Offset(-1, 1).Value
.EntireColumn.AutoFit
End With
Next lc
End With
Set wbk = Nothing
Set wks = Nothing
End Sub
Explanations as comments in code.