Copy data up to last used column with vba - excel

I was successfully able to copy data up to the last used row using VBA. I am trying to do the same thing but copy data from A1 to LastColumn2. Here is the code I have put together thus far:
Sheets("Results").Select
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
Range("A1:" & LastColumn & "2").Select
Selection.Copy
The debugger highlights the third line. This is just a portion of the code - All of the variables have been dimensioned properly.

You are getting the error because LastColumn is number. You want the string equivalent of it i.e the column name. For Further Reading
Avoid the use of .Select and fully qualify your objects. INTERESTING READ
Is this what you are trying?
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Dim LastCol As Long
Dim LastColumn As String
Set ws = ThisWorkbook.Sheets("Results")
With ws
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
'~~> Return column name from number
LastColumn = Split(.Cells(, LastCol).Address, "$")(1)
Set rng = .Range("A1:" & LastColumn & "2")
Debug.Print rng.Address
rng.Copy
End With
End Sub

The problem is that the range you are passing is wrong because it is wating simething like:
Range("A1:C2").Select
and you are passing:
Range("A1:32").Select
So what you can do is:
Range(cells(1,1),cells(2,lastcolumn)).Select
Cell(1,1) = A1 beacuse its is row number 1 column number 1
As mentioned it is better if you just
Range(cells(1,1),cells(lastcolumn,2)).copy
Hope it helps

Related

copy-Paste a range data as many time as there are headers name starting with "X"

I've been trying to find a solution for that problem but nothing came up.
Here is the problem I've got. I would like to copy a variable data range from a sheet called ("Amounts") starting in range "C3" to an other sheet called ("Pasted Amounts") in range F2 as many time as columns, in sheets "Amounts" are starting with the following value " Amounts in USD".
I've been coding something but it doesn't work... I put a counter in a cell to count how many time there are columns starting with the value " Amounts in USD" in order to pick the value appearing in that cell and repeat the paste process. But I've been complicated the code I guess...
Here is my code;
Dim cel2 As Range
Dim counter as Integer
With Sheets("Amounts")
Worksheets("Amounts").Activate
For Each cel2 In Range("A2", Range("A2").End(xlToRight))
If cel2.Value Like "Amount in USD*" Then
counter = counter + 1
Range("U4").Value = counter
End If
With Worksheets("Pasted Amounts").Activate
'~Here is bellow the column named " clients name" I want to paste in "Pasted amounts" sheet (by coping it in the sheet "Amounts"
worksheets("Amounts").Range("C3",range("C3").end(xldown).Select
'~ Paste the range copied in sheet " Pasted Amount" as many time the counter value is
.Copy Range("F2").Resize(.Count * counter)
End With
Next cel2
End With
End sub
Once again, I'd appreciate so much your help...
Mido88
Sub test()
Dim LastColumn As Long, LastRow As Long, counter as Long
With Sheets("Amounts")
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
counter = WorksheetFunction.CountIf(.Range("A1", .Cells(1, LastColumn)), "Amount in USD*")
.Range("C3:C" & LastRow).Copy _
Worksheets("Pasted Amounts").Range("F2").Resize(.Range("C3:C" & LastRow).Count * counter)
End With
End Sub
Or as a silly long one line of code:
Sub test()
Sheets("Amounts").Range("C3:C" & Sheets("Amounts").Cells(Sheets("Amounts").Rows.Count, "C").End(xlUp).Row).Copy Worksheets("Pasted Amounts").Range("F2").Resize(Sheets("Amounts").Range("C3:C" & Sheets("Amounts").Cells(Sheets("Amounts").Rows.Count, "C").End(xlUp).Row).Count * WorksheetFunction.CountIf(Sheets("Amounts").Range("A1", Sheets("Amounts").Cells(1, Sheets("Amounts").Cells(1, Sheets("Amounts").Columns.Count).End(xlToLeft).Column)), "Amount in USD*"))
End Sub
Alright I found the solution!
Thank you again Siddharth and Christofer, your answers helped me a lot to think further...
Here is the solution that worked really well! I used the answer in the previous post I made here:link and added a single line code to paste as many time the range of datas as" Amounts in USD " was found in the previous sheet.
Sorry again for those misunderstandings. I hope that my answer would help you and the other users in need!
Here it is;
Sub Sample()
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim lRowInput As Long
Dim lRowOutput As Long
Dim lCol As Long
Dim i As Long
Dim Col As String
'~~> Set your sheets here
Set wsInput = Sheets("Amounts")
Set wsOutput = Sheets("Pasted Amounts")
With wsInput
'~~> Find last column in Row 2
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
'~~> Loop through columns
For i = 1 To lCol
'~~> Check for your criteria
If .Cells(2, i).Value2 Like "Amount in functional currency*" Then
'~~> Get column name
Col = Split(.Cells(, i).Address, "$")(1)
'~~> Get the last row in that column
lRowInput = .Range(Col & .Rows.Count).End(xlUp).Row
'~~> Find the next row to write to
If lRowOutput = 0 Then
lRowOutput = 2
Else
lRowOutput = wsOutput.Range("A" & wsOutput.Rows.Count).End(xlUp).Row + 1
End If
'~~> Copy the datas ( for each column where Amounts in USD was found)
.Range(Col & "3:" & Col & lRowInput).Copy _
wsOutput.Range("A" & lRowOutput)
~~> SOLUTION BELLOW-Copy the variable data range ("C3")
Worksheets("Amounts").Activate
.Range("C3", Range("C3").End(xlDown)).Copy wsOutput.Range("F" & lRowOutput)
End If
Next i
End With
End Sub
Mido

Paste cells to another worksheet in VBA

I want to paste cells across worksheets in VBA. In the code below, I first select the range of cells, and then paste to another worksheet. But it runs error '9": Subscript out of range. I think the problem is in the last line for copy & paste. Here's my code:
Sub MatchFRB()
' find last row and column
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set StartCell = Range("A1")
LastRow = Sheet22.Cells(Sheet22.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = Sheet22.Cells(StartCell.Row, Sheet22.Columns.Count).End(xlToLeft).Column
' Select cells until meets Threshold=5000000000
Dim i As Integer
Dim Bal As Double
Threshold = 0
For i = 2 To LastRow
Bal = Threshold + Range("AV" & i)
If Threshold > 5000000000# Then
Exit For
End If
Next i
' copy cells from Sheet22 and paste to Sheet21
Sheet22.Range(StartCell, Sheet22.Cells(i, LastColumn)).Copy Worksheets("Sheet21").Range(StartCell, Sheet21.Cells(i, LastColumn))
End Sub
Many thanks!
You have to properly call to your sheet. VBA doesn't accept just the name of the sheet as an object. You have to reference to the sheet with Worksheets("Sheet22"), another option would be to set an object to be this:
Dim ws as object
set ws = Thisworkbook.Worksheets("Sheet22")
This way VBA knows you want Sheet22 from the book that the macro is in; otherwise you could specify the workbook with Workbooks("YourWorkBookName").WorkSheets("SheetName").
From there you could use ws.Range as you were doing with Sheet22. Similarly, StartCell may be a range, but it only acts with the active sheet, so it wouldn't be a bad idea to reference it to a certain sheet and/or book as well. But in this case, I've left it out because it's always A1 and that's simple enough to enter.
Later in your code when you're trying to calculate the balance, you also have to use .Value after you call your range so that you actually access the number stored in the cell. But if you're threshold is what you're checking you should be adding the threshold back to itself. However, I've chosen to just use Bal in this case because it made more sense to me.
Sub MatchFRB()
' find last row and column
Dim LastRow As Long
Dim LastColumn As Long
Dim ws as object
Dim i As Integer
Dim Bal As Double
set ws = Thisworkbook.Worksheets("Sheet22")
LastRow = ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
LastColumn = ws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
' Select cells until meets Threshold=5000000000
Bal = 0
For i = 2 To LastRow
Bal = Bal + ws.Range("AV" & i).Value
If Bal >= 5000000000 Then
Exit For
End If
Next i
' copy cells from Sheet22 and paste to Sheet21
ws.Range("A1:" & Cells(i, LastColumn).Address).Copy Worksheets("Sheet21").Range("A1:", Cells(i, LastColumn).address)
End Sub

Excel VBA offset function

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.

How to append data to a column in a loop

My script takes data from multiple sheets and creates a new spreadsheet. The problem I am running into is how to append to the end of a column. I tried this:
LastRow = Sheets("Test").Cells(Rows.Count, "A").End(xlUp).Row
Where LastRow is defined as a long but I ran into an error when my loop continued going around. Here is what I have so far:
Sub autoFill()
Dim wb As Workbook, ws As Worksheet
Dim LastRow As Long
Dim Unit As String
Dim ddg As Variant, i As Variant
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Mapping")
ddg = ws.Range("F4:F21").Value
For Each i In ddg
Unit = "Unit #" & i
LastRow = Sheets("Test").Cells(Rows.Count, "A").End(xlUp).Row
Sheets(Unit).Range("A2:A100").Copy Destination:=Sheets("Test").Range("A1" & LastRow)
Sheets(Unit).Range("B2:B100").Copy Destination:=Sheets("Test").Range("B1" & LastRow)
Next i
End Sub
Just pick a range WAY above whatever the last row might be in whatever column will be populated (A in this case) when using xlUp. Add 1 to get to the next row:
LastRow = Sheets("Test").Range("A50000").End(xlUp).Row + 1
LAstRow now has a number that is equal to the first unused row in Column A of sheet Test.
Now concatenate that number to "A" to make a range like "A50". Right now you are doing:
Sheets(Unit).Range("A2:A100").Copy Destination:=Sheets("Test").Range("A1" & LastRow)
Which is concatenating the number to "A1" so you get "A150" which is nonsense... Instead:
Sheets(Unit).Range("A2:A100").Copy Destination:=Sheets("Test").Range("A" & LastRow)

Runtime error 13 Type Mismatch VBA to highlight row if value is found in another workbook

I'm learning VBA in Excel 2013 and I posted a question last weekend but didn't receive a response. I've been working on the code more and narrowed the error down to one. I'm trying to highlight a row in a workbook if a value in column A is found in the column A another open workbook.
I get a Runtime error 13: Type mismatch error. That is all that it says and it is for this line of code:
If cell.Value = valuetofind Then
I have looked on numerous sites about this error but I don't see any that match my situation. I think it's b/c 'valuetofind' is a range and it's trying to set a range equal to a value, seen in 'cell.value'. I think all of my variables are declared properly.
I've tried changing it to below so that they are both ranges but that gives the same error:
If cell = valuetofind Then...
Can anyone help with this error?
Sub HighlightRow()
'http://www.vbaexpress.com/forum/showthread.php?26162-Solved-Highlight-ROW-based-on-cell-value
'http://www.mrexcel.com/forum/excel-questions/827262-visual-basic-applications-vlookup-between-2-workbooks.html
'test column just picks any column, I think, to test how far down the rows go to, I think you could choose any column
Const TEST_COLUMN As String = "D" '<=== change to suit
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LastRow As Long
Dim cell As Range
Dim valuetofind As Range
Set ws1 = ThisWorkbook.Sheets(1) 'name will change each day
Set ws2 = ActiveWorkbook.Sheets(1) 'name will change each day
With ws1
LastRow = Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
'LastRow is testing/finding out last row using TEST_COLUMN first before performs rest of macro
End With
Set valuetofind = ws2.Range("A2:A" & LastRow)
'Range("A2:A" & LastRow) is the criteria row where it is looking for Break Down and PM/SM Call below
'Resize(,7) will highlight the row however many columns you tell it to, in this case 7
'cell.Offset(, -6) I think tells to go back 6 columns to column A and start the highlighting there
With ws1
For Each cell In Range("A2:A" & LastRow)
If cell.Value = valuetofind Then
'old, do not use: wb2.Worksheets(wb2SheetName).Range("A2:A" & LastRow)
cell.Offset(, -6).Resize(, 7).Interior.ColorIndex = 39
Else
cell.EntireRow.Interior.ColorIndex = xlNone
End If
Next
End With
End Sub
The code has been altered and is working for anyone who needs help.
This is modified from Dinesh Takyar's video on copying data between worksheets(https://www.youtube.com/watch?v=AzhQ5KiNybk_), though this code below is to highlight rows between workbooks. Both workbooks, destination and source workbooks, need to be open.
I believe the original Run Time 13 Error was b/c the criteria, original variable called 'valuetofind' was Dim as Range, when it is a String. The variable in the code below is now called 'myname' and is Dim as String. But I don't believe the code above would have worked anyway b/c I needed the For/Next to go through each cell in my criteria column.
Thanks to Dinesh and people on this forum.
Sub HighlightRowBtwWorkbook()
Dim wkbkDest As Workbook
Dim i As Long
Dim lastrowDest As Long
Dim lastcolDest As Long
Dim wkbkSource As Workbook
Dim j As Long
Dim lastrowSource As Long
Dim myname As String
Dim lastcolSource As Long
'Destination
Set wkbkDest = ThisWorkbook 'was Workbooks("Destination_VBAHighlight.xlsm") 'was ActiveWorkbook
lastrowDest = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lastcolDest = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lastrowDest
myname = wkbkDest.ActiveSheet.Cells(i, "A").Value
'Source
Set wkbkSource = Workbooks("TESTVBA.xlsm")
wkbkSource.Activate
lastrowSource = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lastcolSource = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For j = 2 To lastrowSource
If ActiveSheet.Cells(j, "A").Value = myname Then
'Activate Destination
wkbkDest.Sheets(1).Activate
ActiveSheet.Range(Cells(i, "B"), Cells(i, lastcolDest)).Interior.Color = RGB(252, 228, 214)
End If
Next j
Next i
'select cell A1 in Destination wkbk to end there
wkbkDest.Sheets(1).Activate
wkbkDest.ActiveSheet.Range("A1").Select
End Sub

Resources