Starting from Sheet "DATA" range B4:Hx, where x is my last row taking by a row count. I need to copy this range and paste it as values on sheet "bat" starting at A1.
Going forward I need to offset columns in 6. So my second copy will be I4:Ox and so one copying appending into bat sheet.
I know where I must stop and I'm informing it using the Funds value.
The first error I'm having is when I try set Column2 = Range("H" & bottomD) value that is giving me "overflow".
And sure I don't know yet if my For loop would work.
Sub Copy_bat()
Dim bottomD As Integer
Dim Column1 As Integer
Dim Column2 As Integer
Dim i As Integer
Dim Funds As Integer
Funds = Sheets("bat").Range("u3").Value
Sheets("DATA").Activate
bottomD = Range("A" & Rows.Count).End(xlUp).Row
Column1 = Range("B4")
Column2 = Range("H" & bottomD)
For i = 1 To Funds
Range(Column1 & ":" & Column2).Copy
Sheets("Data").Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True, Transpose:=False
Column1 = Colum1.Range.Offset(ColumnOffset:=6)
Column2 = Colum2.Range.Offset(ColumnOffset:=6)
Next i
End Sub
Always use Option Explicit at the beginning of every module to prevent from typos. Always! You had typos at the bottom - Colum1 and Colum2.
Avoid Activate and Select (you had Sheets("DATA").Activate) - better performance, smaller error chance. Instead, you should always explicitly tell VBA which sheet you are referring to.
While pasting values you can simply do something like Range2.value = Range1.value. No need to .Copy and then .Paste.
I did my best to understand what you need. From my understanding you did not use Range data type, while you needed that. This caused you errors.
Option Explicit
Sub Copy_bat()
Dim bottomD As Integer
Dim i As Integer
Dim Funds As Integer
Dim rngArea As Range
Funds = Sheets("bat").Range("u3").Value
With Sheets("Data")
bottomD = .Range("A" & .Rows.Count).End(xlUp).Row
Set rngArea = Range(.Range("B4"), .Range("H" & bottomD))
End With
For i = 1 To Funds
Sheets("bat").Cells(Rows.Count, "A").End(xlUp)(2).Resize(rngArea.Rows.Count, rngArea.Columns.Count).Value = _
rngArea.Value
Set rngArea = rngArea.Offset(, 7)
Next
End Sub
I made one rngArea variable of type Range instead of 2 variables (Column1 and Column2). This code takes info from "Data" sheet and puts that to "bat" sheet. Then offsets to right by 7(!) columns in "Data" sheet and puts data in "bat" sheet below the data that was put previously.
Related
I'm trying to copy certain columns from a sheet to another (around 15).
My current method is less than ideal (I think).
Sheets(2).Range("A:A").Value = Sheets(1).Range("C:C").Value
Sheets(2).Range("C:C").Value = Sheets(1).Range("G:G").Value
Sheets(2).Range("D:D").Value = Sheets(1).Range("T:T").Value
It looks repetitive and more importantly it copies the entire column, which slows down the process by loading the empty rows until the end of the sheet as well.
I'm trying to figure out the best possible way to copy the columns just up to the last used column.
This is my current idea, but the empty cells in the second sheet are filled with the not available error value, which defeats the purpose.
lastRow = Sheets(1).Range("C" & Sheets(1).Rows.Count).End(xlUp).Row
Sheets(2).Range("A:A").Value = Sheets(1).Range("C1:C" & lastRow).Value
Any function that I'm probably not aware of? Thank you!
(And yes, this must be done in VBA. Ask my boss 😃.)
As your source range is smaller, you have to adjust the size of your target range.
Sub copyData()
Dim arrColumns(1, 2) As String
'mapping source column : target column
arrColumns(0, 0) = "C": arrColumns(1, 0) = "A"
arrColumns(0, 1) = "G": arrColumns(1, 1) = "C"
arrColumns(0, 2) = "I": arrColumns(1, 2) = "D"
With ThisWorkbook
Dim wsSource As Worksheet: Set wsSource = .Worksheets(1)
Dim wsTarget As Worksheet: Set wsTarget = .Worksheets(2)
End With
Dim lastRow As Long
With wsSource
lastRow = .Range("C" & .Rows.Count).End(xlUp).Row
End With
'now we can do the copying
Dim i As Long
For i = 0 To UBound(arrColumns, 2)
wsTarget.Columns(arrColumns(1, i)).Resize(lastRow).Value = wsSource.Columns(arrColumns(0, i)).Resize(lastRow).Value
Next
End Sub
Furthermore I like to have mapping arrays at the beginning of such a sub.
In case your boss wants another column to be copied - or copy one to another target column this is much easier to handle.
To make it simple, maybe this can work for you:
Sub test()
Dim i As Long
Dim SourceArray As Variant
Dim DestinyArray As Variant
Dim lastRow As Long
'all ranges must be same size to work so all of them will use same lastRow
SourceArray = Array("A1:A", "C1:C", "D1:D")
DestinyArray = Array("C1:C", "G1:G", "T1:T")
lastRow = Sheets(1).Range("C" & Sheets(1).Rows.Count).End(xlUp).Row
For i = LBound(SourceArray) To UBound(SourceArray) Step 1
Sheets(2).Range(DestinyArray(i) & lastRow).Value = Sheets(1).Range(SourceArray(i) & lastRow).Value
Next i
Erase SourceArray
Erase DestinyArray
End Sub
Easy to update if you need to copy more columns, but remember this code will copy always same quantity of cells so if you are copying ranges of different size, then it won't work.
I have a workbook already made and it is set up specifically to create histograms on data read in from a separate program. When I pull the data into the workbook, it all goes into one sheet in my workbook. From here I need to split the data apart and sort it into specific tabs based on part number. I have 9 part numbers total and around 25,000 rows of data a day that needs to be sorted. Column A is the date, B is the serial number, C is the part number, D is a machine code, E is the static flow data, and F is a detail. I need to sort by Column C 9 potential part numbers which look like this "'111". "'123" etc with an apostrophe before each number. They are already in that format. The only data that needs to go to the corresponding worksheet is numbers from Column E. This is what I have so far but it doesn't work.
'For loop to filter through all the available part times and put the data in the correct tab
For i = 1 To 11
'PartType array is all 9 part types possible
Worksheets("Paste Data Here").AutoFilter Field:=3, Criteria1:=PartType(i) 'This is where it fails
Debug.Print ("Filtered")
Worksheets("Paste Data Here").SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Debug.Print ("Selected")
'InputRanges is where in each worksheet the data needs to go, this is established
'in another sub
'TabList is an array of each worksheet in the same order at the PartType array
ThisWorkbook.Sheets(TabList(i)).InputRanges(daterange).Select
ThisWorkbook.Sheets(TabList(i)).InputRanges(daterange).Paste
Debug.Print ("Pasted")
Application.CutCopyMode = False
Debug.Print ("i: " & i)
Debug.Print ("PartType(i): " & PartType(i))
Next i
Neither AutoFilter nor SpecialCells works like that for a worksheet.
You need to specify some kind of range to apply these methods to.
Dim ws As Worksheet
Set ws = Worksheets("Paste Data Here")
ws.UsedRange.AutoFilter Field:=3, Criteria1:=PartType(i)
ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy ThisWorkbook.Sheets(TabList(i)).InputRanges(DateRange)
For i = 1 To 11
Debug.Print ("Searching Part: " & PartType(i))
Dim ws As Worksheet
Set ws = Worksheets("Paste Data Here")
ws.AutoFilterMode = False
Dim rng1 As Range
Set rng1 = Range("C:C").Find(PartType(i), , xlValues, xlWhole)
If Not rng1 Is Nothing Then
Dim lastrow1 As Long
lastrow1 = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Dim copyRange As Range
Set copyRange = ws.Range("E2:E" & lastrow1)
ws.UsedRange.AutoFilter Field:=3, Criteria1:=PartType(i)
copyRange.SpecialCells(xlCellTypeVisible).Copy ThisWorkbook.Sheets(TabList(i)).Range(InputRanges(daterange))
End If
Next i
I need some advice for my code. I really appreciate if some members can edit my code. Thanks
My code below is looking for the name on column B and copy the result on another sheet if 2 conditions met:
- The row.value on column G = "ongoing"
- The row.value on column C = "HP"
When I run this code, got an error-message box "Range of Object"_Worksheet failed.
I am trying to change the set "mytable to ShSReturn.ListObject ("Survey Return")" with mytable as Range, another message error "Subscription out of range"
Sub LOf()
Dim cell As Variant
Dim myrange As Long, lastrow As Long, finalrow As Long, resultrow As Long
Dim mytable As Range
lastrow = ShSReturn.Range("G" & ShSReturn.Rows.Count).End(xlUp).Row
finalrow = ShSReturn.Range("C" & ShSReturn.Rows.Count).End(xlUp).Row
resultrow = ShSReturn.Range("B" & ShSReturn.Rows.Count).End(xlUp).Row
Set mytable = ShSReturn.ListObjects("Survey Return")
cell = 7
For Each cell In mytable
If mytable.Cells(cell, lastrow).Value = "Ongoing" _
And mytable.Cells(cell, finalrow).Value = "HP" Then
mytable.Cells(cell, resultrow).Copy
ShPPT.Cells(cell, 17).PasteSpecial xlPasteValues
resultrow = resultrow + 1
End If
Next cell
End Sub
I think there's some confusion about the nature of your ListObject, as specified in your original code (see comments to the question). When you select a bunch of cells and go to Insert -> Table, then as well as the table object, Excel defines a Range with the name of that table: a named Range. This Range may be referenced directly in VBA as such:
Set mytable = Range("Table1")
Note that Range names may not contain spaces
On the assumption that you have a named Range, it might be something like this:
Sub LOf()
Dim myrange As Long, lastrow As Long, finalrow As Long, resultrow As Long
Dim mytable As Range
lastrow = ShSReturn.Range("G" & ShSReturn.Rows.Count).End(xlUp).Row
finalrow = ShSReturn.Range("C" & ShSReturn.Rows.Count).End(xlUp).Row
resultrow = ShSReturn.Range("B" & ShSReturn.Rows.Count).End(xlUp).Row
Set mytable = ActiveSheet.Range("SurveyReturn") ' It's best to specify which sheet your source data is on. Presumably "ShSReturn" is the CodeName of your results sheet
Dim x As Long
For x = 7 To mytable.Cells(mytable.Cells.Count).Row ' Start at Row 7, and finish at the row number of the last cell in that Range
If mytable.Cells(x, **lastrow**).Value = "Ongoing" And mytable.Cells(x, **finalrow**).Value = "HP" Then
mytable.Cells(x, **resultrow**).Copy
ShPPT.Cells(cell, 17).PasteSpecial xlPasteValues
resultrow = resultrow + 1
End If
Next x
End Sub
Note that the above code will not work in its present form. What I have done is an approximation of what I think you're looking for: however you're going to have to do a bit of work, because the code in your question has some fundamental issues. For example, in your code you have lines like this:
mytable.Cells(cell, resultrow).Copy
However addressed cells within Ranges are in the format Range.Cells(Row, Column) - where Row and Column are numbers. However in your code resultrow as defined at the top is a Row, not a Column. You need to work out what exactly you want to copy, in terms of which row/column and re-write your code accordingly.
If you want to provide clarity, I'll be happy to edit my answer to accommodate what you want.
So I have a VBA that is suppose to copy the on the "data" sheet and paste it on the "Internal Use" via searching a cell on cell in the "Internal Use" I'm not getting an error it is just not doing it and it after I run the macro it just stays on the "data" sheet.
What am I missing?
Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If
Next Row
End Sub
Hard to tell what you're trying to do. Let me know if this is what you want.
Sub CommandButton2_Click()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim nr As Long
Dim project As Variant
Set ws1 = ThisWorkbook.WorkSheets("Internal Use")
Set ws2 = ThisWorkbook.WorkSheets("data")
project = ws1.Range("C4").Value2
With ws1
nr = .Range("A" & .Rows.Count).End(xlUp).Row
For r = 2 To nr
If .Range("F" & r) = project Then
ws2.Range("Q" & r) = .Range("C7")
End If
Next
End With
End Sub
Ricardo,
Your code is working fine. Question is what are you trying to accomplish? If you are trying to paste on 'Internal Use' sheet, you need to activate it. I have added a line to activate it. Please be more specific on what you want to accomplish.
Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Internal Use").Activate
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If
Next Row
End Sub
You want to populate column Q on the data sheet with the value from Worksheet Internal Use cell C7, whenever column F on the same row is equal to cell C4.
I have to say that that's easily solvable with a formula using index match or a conditional formula like =If(F2='Internal Use'!$C$4,'Internal Use'!$C$7,"") (Just paste in column F). At least this is what your code currently more or less does or seems to want to achieve.
That said let's take a look at your code:
First of all avoid .Activate, it's unnecessary overhead. This will activate the worksheet. (By the way, the last .activate you use, is on the data worksheet, hence it stays there) Next you store C4 in an undeclared variable called project that you never use.
Next you reference the cells everywhere in the loop again. This means there is huge overhead on accessing and reading out these cells. Lastly you do this in a loop; I assume this is to avoid filling up any of the other rows.
To make your code work, you could use:
Sub CommandButton2_Click()
Dim project as string
Dim writeValue as string
Dim lr as long
Dim wr as long
project = Worksheets("Internal Use").Range("C4").value
writeValue = Worksheets("data").Range("C7").value
lr = Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("data")
For wr = 2 To lr
If .Range("F" & wr).value = project Then
.Range("Q" & rw).value = writeValue
End If
Next wr
End With
End Sub
This will do the trick.
Neater would be to avoid the for loop and testing all cells. Two options are putting the entire F and Q columns into arrays and loop through those simultaniously while altering the Q-array before dumping the values back in the sheet, or use a Find-algorithm such as Chip Pearons FindAll: http://www.cpearson.com/excel/findall.aspx
I have a rather silly problem. I have a macro (linked to a button) which copies cells A1:A2 from one worksheet (namedFP) to another worksheet (Log). I intend to copy these 2 cells on the log sheet every time I hit the macro button. The problem I am facing right now is that when I use the button multiple times, these cells are getting copied over each other instead of using the next available row to paste the cells.
This is what I have now, and I tried changing the 'Rowcount+1' to 'RowCount+2' but that did not work. Any help is appreciated.
DHRSheet.Select
Range("A1:A2").Select
Selection.Copy
LogSheet.Select
RowCount = LogSheet.UsedRange.Rows.Count
Dim r As Integer
r = RowCount + 1
Dim infocell As Range
Set infocell = Cells(r, 1)
infocell.Select
ActiveSheet.Paste
infocell.Value = DHRSheet.Name & "$" & infocell.Value
DHRSheet.Select
ActiveWorkbook.Save
Is this what you are trying?
Sub Sample()
Dim LogSheet As Worksheet, DHRSheet As Worksheet
Dim lrow As Long
'~~> Change this as applicable
Set LogSheet = Sheets("Sheet1")
Set DHRSheet = Sheets("Sheet2")
With LogSheet
lrow = LogSheet.Range("A" & .Rows.Count).End(xlUp).Row + 1
DHRSheet.Range("A1:A2").Copy .Range("A" & lrow)
End With
End Sub
Here's a function I use that is very reliable and always returns the last row of a sheet without fail:
(possibly excessive for your simple use, but I always recommend it)
Public Function LastRowOfSheet(ByVal TestSheetNumber As Variant)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Input: Sheet index # or Sheet name
' Output: Last row of sheet.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim intNumberOfRowsInWorksheet As Long
intNumberOfRowsInWorksheet = Sheets(TestSheetNumber).UsedRange.Rows.Count
intNumberOfRowsInWorksheet = intNumberOfRowsInWorksheet + Sheets(TestSheetNumber).UsedRange.Row - 1
LastRowOfSheet = intNumberOfRowsInWorksheet
End Function
And I'd clean up your above code and use something like this:
Sub Move2RowsToEnd()
Dim iNextRowOfOutput As Long
Dim iRowNumber As Long
'- use the function to find the last row of the output sheet. we'll be pasting to the first row after.
iNextRowOfOutput = (LastRowOfSheet("Log") + 1)
'- you can adjust this for loop to loop through additional cells if you need to paste more than 2 rows in the future.
For iRowNumber = 1 To 2
'- for each row of input (2 total) set the value of the output sheet equal to it.
Sheets("Log").Range("A" & iNextRowOfOutput).Value = Sheets("namedFP").Range("A" & iRowNumber).Value
iNextRowOfOutput = iNextRowOfOutput + 1
Next iRowNumber
'- not sure which of these you want to save (one or both)
Sheets("namedFP").Save
Sheets("Log").Save
End Sub
Just paste the function above or below the Subroutine and let me know if you have any issues or questions regarding the 'Move2RowsToEnd' code.