The left() function (not Leftsub()) is NOT populating the destination range. What am I doing wrong? Thank you!!!
Sub LeftSub()
Dim SourceRange As Range, DestinationRange As Range, i As Integer, LastRow As Integer
Worksheets("JE_data").Activate
Range("J2").Activate
LastRow = Cells(Rows.count, "A").End(xlUp).row
'Define our source range:
Set SourceRange = Worksheets("JE_data").Range(Cells(2, 10), Cells(LastRow, 10))
'Define our target range where we will print.
'Note that this is expected to be of same shape as source
Set DestinationRange = Worksheets("JE_data").Range(Cells(2, 11), Cells(LastRow, 11))
'Iterate through each source cell and print left 30 characters in target cell
For i = 2 To SourceRange.count
DestinationRange(i, 11).Value = Left(SourceRange(i, 10).Value, 30)
Next i
End Sub
The error is here
Left(SourceRange(i, 10).Value, 30)
Already you have defined SourceRange as a Range of Cells
Set SourceRange = Worksheets("JE_data").Range(Cells(2, 10), Cells(LastRow, 10))
Again you are pointing using i, 10 gives you
.Range(Cells(2, 10), Cells(LastRow, 10))(i,10)
That points to the cell relative to upper left cell of your selection which means (2+i,10+10)th Cell (as (2,10) is your Upper left cell of selected Range) that doesn't work. Instead you can directly use this command
Left(Worksheets("JE_data").Cells(i,10).Value, 30)
And for DestinationRange As well
Worksheets("JE_data").Cells(i, 11).Value = Left(Worksheets("JE_data").Cells(i,10).Value, 30)
Hope this helps
Just from quickly looking at it - try replacing
DestinationRange(i, 11).Value = Left(SourceRange(i, 10).Value, 30)
with
DestinationRange(i, 1).Value = Left(SourceRange(i, 1).Value, 30)
When I want to find the last cell in a sheet, I use this:
llof = ActiveSheet.UsedRange.SpecialCells(xlLastCell).address
or
llof = ActiveSheet.UsedRange.SpecialCells(xlLastCell).row
the beauty of this command is that it re-sets the spreadsheet pointers so that any un-used space from adding and deleting lines are removed.
Related
I am running the below VBA code -
lastColumn = Cells(5, Columns.count).End(xlToLeft).Column
count_dates = Range("H2").Value
Set cellSource = Range(Cells(6, 13).Address)
Set cellTarget = Range(Cells(6, 13), Cells(count_dates + 5, lastColumn))
cellSource.AutoFill Destination:=cellTarget, Type:=xlFillDefault
The code is running perfectly fine on one PC (Excel 2016), but not running on the other (Excel 2010). I am unable to figure out the reason for the same.
The cell (6,13) has a formula which i want to drag both horizontally right and vertically down
The error I get is -
Error 1004 : Autofill method of range class failed
In Excel 2010 Autofill works in a single direction only, either horizontal or vertical. Therefore, if you wish to fill a 2-dimensional range you should first fill one row horizontally (including the source cell) and then use that row as source copy the entire row down. The code below does that.
Sub AutoFillRange()
Dim lastColumn As Long
Dim count_Dates As Long
Dim cellSource As Range, cellTarget As Range
lastColumn = Cells(5, Columns.Count).End(xlToLeft).Column
count_Dates = Range("H2").Value
Set cellSource = ActiveSheet.Cells(6, "M")
If lastColumn <> cellSource.Column Then
' return an unexpected result if lastColumn is smaller than cellSource.Column
Set cellTarget = cellSource.Resize(1, Abs(lastColumn - cellSource.Column + 1))
cellSource.AutoFill Destination:=cellTarget, Type:=xlFillDefault
Set cellSource = cellTarget
End If
Set cellTarget = cellSource.Resize(count_Dates, cellSource.Columns.Count)
cellSource.AutoFill Destination:=cellTarget, Type:=xlFillDefault
End Sub
I am new to macro writing and I need some help.
I have one sheet and need to copy the columns and reorder them to paste into a software program.
I want to copy A2 - the last data entry in column A and paste it into A1 on Sheet2
I want to copy B2 - the last data entry in column A and paste it into K1 on Sheet2
I want to copy C2 - the last data entry in column A and paste it into C1 on Sheet2
I want to copy D2 - the last data entry in column A and paste it into D1 on Sheet2
Then from Sheet 2, I want to copy A1:KXXXX (to the last entry in column A) and save it on the clipboard to paste into the other application
Here is my code, I have tried... (I know this is just for copying column A, but I got stuck there.)
Sub Copy()
aLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("A2" & aLastRow).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
Thank you so much for your help!
Jess
Try this instead. Given that you said you got an error with the paste code and I am still using that, I think you'll still have an error there. Post the error message. Hopefully we can figure that out.
Sub copyStuff()
Dim wsIn As Worksheet
Set wsIn = Application.Worksheets("Sheet1")
Dim endRow As Long
wsIn.Activate
endRow = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row
Dim r As Range
Dim wsOut As Worksheet
Set wsOut = Application.Worksheets("Sheet2")
' column a to column a
Set r = wsIn.Range(Cells(2, 1), Cells(endRow, 1))
r.Copy
wsOut.Range("A1").PasteSpecial xlPasteAll
' column b to column k
Set r = wsIn.Range(Cells(2, 2), Cells(endRow, 2))
r.Copy
wsOut.Range("K1").PasteSpecial xlPasteAll
' column c to column c
Set r = wsIn.Range(Cells(2, 3), Cells(endRow, 3))
r.Copy
wsOut.Range("C1").PasteSpecial xlPasteAll
' column d to column d
Set r = wsIn.Range(Cells(2, 4), Cells(endRow, 4))
r.Copy
wsOut.Range("D1").PasteSpecial xlPasteAll
' Copy data from sheet 2 into clipboard
wsOut.Activate
Set r = wsOut.Range(Cells(1, 1), Cells(endRow - 1, 11))
r.Copy
End Sub
My original answer is below here. You can disregard.
This should accomplish your first goal:
Sub copyStuff()
Dim wsIn As Worksheet
Set wsIn = Application.Worksheets("Sheet1")
Dim endRow As Long
endRow = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row
Dim r As range
Set r = wsIn.range(Cells(2, 1), Cells(endRow, 4))
r.Copy
Dim wsOut As Worksheet
Set wsOut = Application.Worksheets("Sheet2")
wsOut.range("A1").PasteSpecial xlPasteAll
End Sub
I copied all 4 columns at once since that would be much faster but it assumes the columns are the same length. If that isn't true you would need to copy one at a time.
The data should be in the clipboard at the end of the macro.
Edit: I removed "wsIn.Activate" since it isn't really needed.
Edit 2: Oops! I just noticed you wanted the output in different columns. I'll work on it.
Generally you want to avoid .Select and .Paste when copying values and rather copy by .value = .value:
Sub Copy()
Dim aLastRow As Long
Dim clipboard As MSForms.DataObject
Set clipboard = New MSForms.DataObject
aLastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet2").Range("A1:A" & aLastRow - 1).Value = Sheets("Sheet1").Range("A2:A" & aLastRow).Value
Sheets("Sheet2").Range("K1:K" & aLastRow - 1).Value = Sheets("Sheet1").Range("B2:B" & aLastRow).Value
Sheets("Sheet2").Range("C1:D" & aLastRow - 1).Value = Sheets("Sheet1").Range("C2:D" & aLastRow).Value
clipboard.SetText Sheets("Sheet2").Range("A1:K" & aLastRow - 1).Value
clipboard.PutInClipboard
End Sub
I'm trying to copy data from columns C,D,J,P when the value in column I is "O"
I'm very new at VBA and the best approach I could think of what to use an IF statement, but I haven't been able to paste more than two consecutive columns.
sub firsttry
Dim bodata As Worksheet
Dim bopresentation As Worksheet
Set bodata = Worksheets("BO Data")
Set bopresentation = Worksheets("BO presentation")
bodata.Activate
Dim i As Integer
i = 1
For i = 1 To 20
If bodata.Cells(i, 9).Value = "O" Then
bodata.Range(Cells(i, 3), Cells(i, 4)).Copy
bopresentation.Range("b20").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
Else
End if
Next
end sub
Range doesn't work like that: try this:
For i = 1 To 20
If bodata.Cells(i, 9).Value = "O" Then
Application.Union(bodata.Cells(i, 3), bodata.Cells(i, 4), _
bodata.Cells(i, 10), bodata.Cells(i, 16)).Copy
bopresentation.Range("b20").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
End if
Next
Your approach itself is exactly right. Looping over a range of cells is usually the most efficient way of handling data. In your current code you'd simply need to repeat the copy for the cells missing inside the loop.
In VBA, however, "pasting" in a seperate line of code if rarely necessary. It is also good coding practise to define all your variables at the top of your code.
Here is different approach using the For each-loop and summing up the wanted range with the Union method:
Dim rCell as Range
Dim rSource as Range
'Define the source range as the entire column C
With ThisWorkbook.Worksheets("BO Data")
Set rSource = .Range("C1", .Cells(Rows.Count, 3).End(xlUp))
End with
'Loop over each cell in the source range and check for its value
For each rCell in rSource
If rCell.Value = "0" Then
'If requirement met copy defined cells to target location
With ThisWorkbook.Worksheets("BO Data")
Application.Union(.Cells(rCell.Row, 3), _
.Cells(rCell.Row, 4), _
.Cells(rCell.Row, 10), _
.Cells(rCell.Row, 16) _
).Copy Destination = ThisWorkbook.Worksheets("BO Presentation").Range("B2")
End With
Next rCell
This, of course, loops over all cells in Column C. If you want to limit the range, you can simply adjust rSource to your needs.
I am copying information from one workbook to another. The code I have so far works great if every column has data. It does not work when I am trying to repeatedly copy information from column A and B of worksheet(supplementary expenses) to worksheet(expenses) and column B is blank. As the next time the sub is run and Column B does have values they are placed in the next blank cell, not the cell that is correlated to column A.
Here is the code I have so far:
Sub SupplementaryExpenses()
Dim x As Workbook
Dim y As Workbook
Set y = Workbooks.Open("File Path")
Set x = Workbooks.Open("File Path")
x.Sheets("b.1 Supplementary expenses").Range("a9", Range("a9").End(xlDown)).Copy
y.Sheets("Expenses").Range("a1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
x.Sheets("b.1 Supplementary expenses").Range("b9", Range("b9").End(xlDown)).Copy
y.Sheets("Expenses").Range("b1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
x.Sheets("b.1 Supplementary expenses").Range("c9", Range("c9").End(xlDown)).Copy
y.Sheets("Expenses").Range("c1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Also any time this sub is run it would be helpful if there were someway to fill column L with the flag 201601 and then change to 201602 when I bring in the next months data.
Try this:
Sub SupplementaryExpenses()
Dim x As Workbook
Dim y As Workbook
Dim lastrow As Long
Dim tRow as long
Set y = Workbooks.Open("File Path")
Set x = Workbooks.Open("File Path")
With x.Sheets("b.1 Supplementary expenses")
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
tRow = y.Sheets("Expenses").Range("a1").End(xlDown).Offset(1, 0).Row
y.Sheets("Expenses").Range("A" & trow).Resize(lastrow - 8, 3).Value = .Range(.Cells(9, 1), .Cells(lastrow, 3)).Value
y.Sheets("Expenses").Range("D" & trow).Resize(lastrow - 8, 1).Value = .Range(.Cells(9, 8), .Cells(lastrow, 8)).Value
End With
End Sub
It will take all of the three columns at once and assign the values to the new area. It will not care about blanks in column B or C.
This should be faster than copy/paste as you only want the values.
Get the last used row and change out your range statements similar to this:
Dim LastRow
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
x.Sheets("b.1 Supplementary expenses").Range(Cells(9, 1), Cells(LastRow, a)).Copy 'this is R1C1 format meaning row then column
You can use this for filling a column
If you put it after the rest of your code and ensure that you have the sheet you want column L populated with active:
sDate = Format(Date, "yyyymm")
For i = 2 To LastRow' you may need to grab this anew if you added lines
If Cells(i, "L") = vbNullString Then 'ensures that there isn't anything in the cell
Cells(i, "L").value = sDate
End If
Next
This is my Excel sheet. Columns G and Column J have the same values but in different order.
The code runs and moves the values from Column J to Column H, beside the same value of column G.
The problem with this is that when there are two values the same it moves it to the first value it finds in Column H. The value 747.00 in J:2 must move to H:2 while the value 747.00 in J:5 must move to H:6 not to H:2.
This is the code:
Dim cel As Range, cel2 As Range
Dim lastRow As Long
lastRow = Cells(Rows.Count, 10).End(xlUp).Row
For Each cel In Range(Cells(1, 7), Cells(lastRow, 7))
For Each cel2 In Range(Cells(1, 10), Cells(lastRow, 10))
If cel2.Value = cel.Value Then
cel.Offset(0, 1).Value = cel2.Value
cel2.Value = ""
End If
Next cel2
Next cel
It sounds like you are cycling through column J and looking for a match in column G. I've reversed that by cycling through column G and looking for a match in column J. Once one match has been found it is moved over to column H thereby removing it from column J.
Sub match_em_up()
Dim rwg As Long, rwj As Long
With Worksheets("Sheet1")
For rwg = 2 To .Cells(Rows.Count, "G").End(xlUp).Row
If CBool(Application.CountIf(.Columns("J"), .Cells(rwg, "G").Value2)) Then
rwj = Application.Match(.Cells(rwg, "G").Value2, .Columns("J"), 0)
.Cells(rwg, "H") = .Cells(rwj, "J").Value2
.Cells(rwj, "J").ClearContents
End If
Next rwg
End With
End Sub
Before:
After: