I have data on a large number of rows 200000+ and 20 columns or less that I would like to graph. Because it is so large graphing becomes problematic. I would like to copy every nth row to a new sheet and graph from the new sheet.
I can accomplish the task by entering and dragging offset formula.I would like to do this same task dynamically with VBA code. In this code I am trying to enter offset formula into cell a1 of sheet2 and copy the formula to a range defined by data range on sheet1. It gives error "autofill method of range class failed" on last line.
Sub copy_5()
Dim startCol As String
Dim startRow As Long
Dim lastRow As Long
Dim lastCol As Long
Dim myCol As String
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Set ws = ThisWorkbook.Sheets("sheet1")
startCol = "a"
startRow = 1
lastRow = ws.Range(startCol & ws.Rows.Count).End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
myCol = GetColumnLetter(lastCol)
Set rng = ws.Range(startCol & startRow & ":" & myCol & lastRow)
For Each cell In rng
Next cell
With ActiveWorkbook
.Sheets.Add(after:=.Sheets(.Sheets.Count)).Name = "sheet2"
End With
Range("a1").Value = ("=OFFSET(data!A1,(ROW()-1)*5,0)")
Range("a1").AutoFill Destination:=Range(startCol & startRow & ":" & myCol & lastRow)
End Sub
It gives error
"autofill method of range class failed"
on last line.
I would like it to fill the same number of columns in sheet2 as are in sheet1.
Related
I m working on a file with about 1200 rows and more than 171 columns. I am trying to consolidate some data and the following Sub is a part of a bigger work. I ended up in having the sales data in different columns (nothing we can do about it - this is a consequence of a text to column transformation). So what I am doing is taking for each row the last data (which is my sales) and move them into the same column but this is very time consuming. I am wondering if you have some tips to make this process faster:
Sub MoveSales()
Dim DestinationWs As Worksheet
Dim MyRange As Range
Dim destinationLastRow As Long
Dim LastColumn As Long
Dim row_no As Long
Set DestinationWs = ThisWorkbook.Worksheets("Testing")
destinationLastRow = DestinationWs.Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For row_no = 2 To destinationLastRow
Dim lColumn As Long, ColLetter As String
lColumn = DestinationWs.Cells(row_no, Columns.Count).End(xlToLeft).Column
ColLetter = Split(Cells(1, lColumn).Address, "$")(1)
Set MyRange = DestinationWs.Range(ColLetter & row_no)
For Each cell In MyRange
cell.Copy
DestinationWs.Range("FP" & row_no).PasteSpecial Paste:=xlPasteValues
Next cell
Next
Application.ScreenUpdating = True
End Sub
Thank you
I want to calculate the Average of column Q and place the answer 2 cells below the last value in column Q. The code I'm using performs the calculation and gives me the average of the values between Q2 and the end of column Q if I insert a msgbox but I can't get it to put the answer into the correct cell.
Sub AverageRates()
With ActiveSheet
'Determine last row
Dim lastRow As Long
Dim cellRange As Range
Dim myAvg As Double
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
'Average rate calculation
myAvg = Application.WorksheetFunction.Average(Range("Q1:Q" & lastRow))
Range("Q2:Q" & lastRow).Value = myAvg
'place the calculated average value 2 cells below the last cell in column Q
Set cellRange = Range("Q" & Lastrow").offset(2,0).select
End With
End Sub
You were pretty close ... try:
Option Explicit
Sub AverageRates()
Dim lastRow As Long
Dim myAvg As Double
With ActiveSheet
lastRow = .Cells(.Rows.Count, "Q").End(xlUp).Row
myAvg = Application.WorksheetFunction.Average(Range("Q1:Q" & lastRow))
Range("Q" & lastRow).Offset(2, 0).Value = myAvg
End With
End Sub
For a multi-column answer, assuming the columns are not equal in length (if so, then you could use an approach like #BigBen suggests), then you could do something like:
Sub AverageRates2()
Dim mySheet As Worksheet
Dim myColumn As Range
Dim myDataSet As Range
Dim lastRow As Long
Dim myAvg As Double
Set mySheet = ActiveSheet
For Each myColumn In mySheet.Range("J:Q").Columns
lastRow = mySheet.Cells(mySheet.Rows.Count, myColumn.Column).End(xlUp).Row
myAvg = Application.WorksheetFunction.Average(myColumn.Rows(1).Resize(lastRow, 1))
myColumn.Rows(lastRow).Offset(2, 0).Value = myAvg
Next
End Sub
I am trying to add a button, that adds a new column after the last column with values. This works.
Now I want to copy values to the new column. Values shall be copied from the last column from row 32 to the last one with a value in column A.
Right now Ihave a code for copying the whole column. How do I concentrate on the specific range?
Sub AddMeeting()
Dim ws As Worksheet
Dim lastcol As Long
Set ws = ActiveSheet
lastcol = ws.Cells(32, ws.Columns.Count).End(xlToLeft).Column
Columns(lastcol).Copy Destination:=Columns(lastcol + 1)
Range ((Cells.Columns.Count.End(xlLeft)) & Range(32)), (lastcol + 1) & Cells.Rows.Count.End(xlUp)
Application.CutCopyMode = False
End Sub
Values shall be copied from the last column from row 32 to the last one with a value in column A
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, lCol As Long
Dim LastColumn As String
Dim rngToCopy As Range
'~~> Set this to the relevant worksheet
Set ws = Sheet1
With ws
'~~> Find last row in Col A
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Find last column in row 32
lCol = .Cells(32, .Columns.Count).End(xlToLeft).Column
'~~> Get Column Name from column number
' https://stackoverflow.com/questions/10106465/excel-column-number-from-column-name
LastColumn = Split(Cells(, lCol).Address, "$")(1)
Set rngToCopy = .Range("A32:" & LastColumn & lRow)
Debug.Print rngToCopy.Address
With rngToCopy
'
' Do what you want here
'
End With
End With
End Sub
I have a script that is used to find the last entry in a particular table column across different sheets and paste them into a master sheet list. It's operating as "find last used row in column B" but evidently table rows, even if they're blank, count as used rows and so most of my returns are blank because the actual value I'm looking for was entered at the top of the table instead of in the last row. It's also important to note that there are multiple stacked tables on these sheets, but each table only ever has ONE value in the B column, and I'm only ever looking for the most recent one.
Is there a way to tell excel not to count blank table rows as used rows? I'm only interested in returning the last value in column B, even if it may not be the last table row.
Dim rng As Range
Dim cell As Range
Dim result As String
Dim result_sheet As Long
Dim LastRow As Long
Set rng = Range("A2:A200")
For Each cell In rng
result = cell.Value
LastRow = Worksheets(result).Cells(Worksheets(result).Rows.Count, "B").End(xlUp).row
cell.Offset(0, 1).Value = Worksheets(result).Range("B" & LastRow).Value
Next cell
Here is one way
Sub Sample()
Dim ws As Worksheet
Dim tmplRow As Long, lRow As Long, i As Long
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
tmplRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = tmplRow To 1 Step -1
If Len(Trim(.Range("B" & i).Value)) <> 0 Then
lRow = i
Exit For
End If
Next i
If lRow = 0 Then lRow = 1
MsgBox "The last row is " & lRow
End With
End Sub
Screenshot
And another way
Sub Sample()
Dim ws As Worksheet
Dim tbl As ListObject
Dim lRow As Long, endRow As Long, startRow As Long, i As Long
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Change this to the relevant table number
Set tbl = .ListObjects(1)
endRow = tbl.Range.Rows.Count
startRow = tbl.Range.Row
For i = endRow To startRow Step -1
If Len(Trim(.Range("B" & i).Value)) <> 0 Then
lRow = i
Exit For
End If
Next i
MsgBox lRow
End With
End Sub
Am fairly new to excel and was wondering if there is an easier way to do a routine cut copy paste I do. I have a worksheet that has a long list of columns which looks like following:
Name Age Occupation Major WorkEx Position.....
I want the macro to copy some predetermined columns from worksheet 1 to worksheet 2 i.e each time I copy raw data into worksheet 1 worksheet 2 should be auto-populated with the selected columns. In this case for example,if I paste the aforementioned columns into worksheet 1, then Name, Major and Position should automatically be copied to worksheet 2.
A point to note is that the raw data is not always in order as shown above. I believe the key is to locate/find the header and then copy the entire column on to worksheet 2 on specific columns.
In this case worksheet 2 will always have Col 8-10 and Col 16 as blank.
Would anyone be able to help me with this issue? Let me know if any additional details are necessary.
Try this.. Just replace test1 with your column names, etc.
Remember to add the column number instead of targetCol as you want to hardcode it. I used the range object to copy data.
Option Explicit
Sub CopyCode()
'Declaring the variable lColumn as long to store the last Column number
Dim lColumn As Long
'Declaring the variable iCntr as long to use in the For loop
Dim iCntr As Long
Dim lastRow As Long
Dim lastCol As Long, targetCol As Long
Dim wks As Worksheet, targetWks As Worksheet
Dim rng As Range
Dim fCol As String
' Set wks so it is the activesheet
Set wks = ThisWorkbook.Sheets("Sheet1")
Set targetWks = ThisWorkbook.Sheets("Sheet2")
lastCol = wks.Cells(1, wks.Columns.Count).End(xlToLeft).Column
'Assigning the last Column value to the variable lColumn
lColumn = lastCol
'Using for loop
For iCntr = lColumn To 1 Step -1
If LCase(wks.Cells(1, iCntr)) Like LCase("Test1") Then
' Find column letter
fCol = GetColumnLetter(iCntr)
lastRow = wks.Range(fCol & wks.Rows.Count).End(xlUp).Row
' Declare range object
Set rng = wks.Range(fCol & "2:" & fCol & lastRow)
' Use Range object to copy data
rng.Copy _
Destination:=targetWks.Cells(1, targetCol) ' Replace targetCol with number of column (A=1, B=2, etc.)
End If
If LCase(wks.Cells(1, iCntr)) Like LCase("Test2") Then
' Find column letter
fCol = GetColumnLetter(iCntr)
lastRow = wks.Range(fCol & wks.Rows.Count).End(xlUp).Row
' Declare range object
Set rng = wks.Range(fCol & "2:" & fCol & lastRow)
' Use Range object to copy data
rng.Copy _
Destination:=targetWks.Cells(1, targetCol) ' Replace targetCol with number of column (A=1, B=2, etc.)
End If
If LCase(wks.Cells(1, iCntr)) Like LCase("Test") Then
' Find column letter
fCol = GetColumnLetter(iCntr)
lastRow = wks.Range(fCol & wks.Rows.Count).End(xlUp).Row
' Declare range object
Set rng = wks.Range(fCol & "2:" & fCol & lastRow)
' Use Range object to copy data
rng.Copy _
Destination:=targetWks.Cells(1, targetCol) ' Replace targetCol with number of column (A=1, B=2, etc.)
End If
' etc etc
Next
End Sub
Function GetColumnLetter(colNum As Long) As String
Dim vArr
vArr = Split(Cells(1, colNum).Address(True, False), "$")
GetColumnLetter = vArr(0)
End Function