I have 2 workbooks and am trying to find a way to copy a column from wb1 into wb2. I am aware I could just copy/paste, but the idea is to make something so my boss can click the macro and everything populates.
I have been trying a code I came across in another question:
Sub Import()
Dim sourceColumn As Range
Dim destColumn As Range
Set sourceColumn = Workbooks("C:\Documents and Settings\********\My Documents\*********.xlsm").Worksheets(2).Columns("BL")
Set destColumn = Workbooks("C:\Documents and Settings\********\My Documents\*********.xlsm").Worksheets(2).Columns("A")
sourceColumn.Copy Destination = destColumn
End Sub
When I run this, I get a "Subscript Out Of Range" Error.
The source column contains a formula relying on other columns and the destination column is empty, but even when I ran this on dummy workbooks with small digits I got the same error.
Is there something super basic I am missing here?
EDIT : Just realized what's probably missing from that piece of code you have. Add a ":" in there! Change to destination:=Workbooks(".... and it should work fine.
Extra details : When working with function parameters, you have to add the ":" in order to specify to the computer you're not evaluating an equality, but doing a parameter assignment.
(Old, flashy answer)
As I assume this is what you're trying to do; this script will probably do what you want. The style will NOT be preserved however.
Sub yourSub()
Application.ScreenUpdating = False 'Disables "Screen flashing" between 2 workbooks
Dim colA As Integer, colB As Integer
Dim rowA As Integer, rowB As Integer
Dim wbA As Workbook, wbB As Workbook
Set wbA = ThisWorkbook
Set wbB = Workbooks.Open("C:/YourFilePath/YourFile.xls")
colA = 1 'Replace "1" with the number of the column FROM which you're copying
colB = 1 'Replace "1" with the number of the column TO which you're copying
rowA = 1 'Replace "1" with the number of the starting row of the column FROM which you're copying
rowB = 1 'Replace "1" with the number of the row of the column TO which you're copying
wbA.Activate
lastA = Cells(Rows.Count, colA).End(xlUp).Row 'This finds the last row of the data of the column FROM which you're copying
For x = rowA To lastA 'Loops through all the rows of A
wbA.Activate
yourData = Cells(x, colA)
wbB.Activate
Cells(rowB, colB) = yourData
rowB = rowB + 1 'Increments the current line of destination workbook
Next x 'Skips to next row
Application.ScreenUpdating = True 'Re-enables Screen Updating
End Sub
I didn't have time to test this yet. Will do as soon as possible.
Related
Just started a new job. I'm automating a month-end report and I'm new at VBA. Been googling most of my issues with success, but I've finally run into a wall. In essence I'm downloading some data from SAP and from there I need to build a report.
My question is: How to do a sumif function using loops in VBA?
Data pull:
Sheet1 contains a product code and purchase amounts (columns A & B) respectively. One product code can have several purchases (several rows with the same product code).
Steps so far:
I arranged the data sheet1 to be in ascending order.
Copied unique values for the product codes onto another sheet (sheet2). So Sheet2 has a list of all the products (in ascending order).
I want to get the sum of all purchases in sheet2 column B (per product code). I know how to do this using formulas, but I need to automate this as much as possible. (+ I'm genuinely interested in figuring this out)
This is what I did in VBA so far:
Sub Macro_test()
Dim tb As Worksheet
Dim tb2 As Worksheet
Dim x As Integer
Dim y As Integer
Dim lrow As Long
Set tb = Sheets("sheet1")
Set tb2 = Sheets("sheet2")
lrow = tb.Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To lrow
For y = 2 To lrow
If tb2.Cells(x, 1).Value = tb.Cells(y, 1).Value Then
tb2.Cells(x, 2).Value = tb.Cells(y, 2).Value
End If
Next y
Next x
End Sub
If i'm not mistaken, for each product_code in sheet2 col A, I'm looping through all the product codes in sheet1 and getting back the LAST value it finds, instead of the sum of all values... I understand why it doesn't work, I just don't know how to fix it.
Any help would be much appreciated. Thanks!
This statement overwrites the value of tb2.Cells(x, 2).Value at each iteration:
tb2.Cells(x, 2).Value = tb.Cells(y, 2).Value
Instead, I think you need to keep adding to it:
tb2.Cells(x, 2).Value = tb2.Cells(x, 2).Value + tb.Cells(y, 2).Value
But I don't like the looks of your double-loop which uses only one lrow variable to represent the "last row" on the two different worksheets, that could be causing some issues.
Or, in your loop do something like this which I think will avoid the duplicate sum. Still, assumes the second worksheet doesn't initially have any value in
' Base our lRow on Sheet2, we don't care how many rows in Sheet1.
lrow = tb2.Cells(tb2.Rows.Count, 1).End(xlUp).Row
Dim cl as Range
Set cl = tb.Cells(2,1) 'Our initial cell value / ID
For x = 2 to lRow '## Look the rows on Sheet 2
'## Check if the cell on Sheet1 == cell on Sheet2
While cl.Value = tb2.Cells(x,1).Value
'## Add cl.Value t- the tb2 cell:
tb2.Cells(x, 2).Value = tb2.Cells(x, 2).Value + cl.Offset(0,1).Value
Set cl = cl.Offset(1) '## Reassign to the next Row
Wend
Next
But it would be better to omit the double-loop and simply use VBA to do 1 of the following:
1. Insert The Formula:
(See Scott Holtzman's answer).
This approach is better for lots of reasons, not the least of which is that the WorksheetFunction is optimized already, so it should arguably perform better though on a small dataset the difference in runtime will be negligible. The other reason is that it's stupid to reinvent the wheel unless you have a very good justification for doing so, so in this case, why write your own version of code that accomplishes what the built-in SumIf already does and is specifically designed to do?
This approach is also ideal if the reference data may change, as the cell formulas will automatically recalculate based on the data in Sheet1.
2. Evaluate the formula & replace with values only:
If you prefer not to retain the formula, then a simple Value assignment can remove the formula but retain the results:
With .Range(.Range("B2"), .Range("A2").End(xlDown).Offset(, 1))
.FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)"
.Value = .Value 'This line gets rid of the formula but retains the values
End With
Use this approach if you will be removing Sheet1, as removing the referents will break the formula on Sheet2, or if you otherwise want the Sheet2 to be a "snapshot" instead of a dynamic summation.
If you really need this automated, take advantage of VBA to place the formula for you. It's very quick and easy using R1C1 notation.
Complete code (tested):
Dim tb As Worksheet
Dim tb2 As Worksheet
Set tb = Sheets("sheet1")
Set tb2 = Sheets("sheet2")
Dim lrow As Long
lrow = tb.Cells(tb.Rows.Count, 1).End(xlUp).Row
tb.Range("A2:A" & lrow).Copy tb2.Range("A2")
With tb2
.Range("A2").CurrentRegion.RemoveDuplicates 1
With .Range(.Range("B2"), .Range("A2").End(xlDown).Offset(, 1))
.FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)"
End With
End With
Note that with R1C1 notation the C and R are not referring to column or row letters . Rather they are the column and row offsets from the place where the formula is stored on the specific worksheet. In this case Sheet!C[-1] refers to the entire A column of sheet one, since the formula is entered into column B of sheet 2.
I wrote a neat little algorithm (if you can call it that) that does what you want them spits out grouped by totals into another sheet. Basically it loops through the first section to get unique names/labels and stores them into an array. Then it iterates through that array and adds up values if the current iteration matches what the current iteration of the nested loop position.
Private Sub that()
Dim this As Variant
Dim that(9, 1) As String
Dim rowC As Long
Dim colC As Long
this = ThisWorkbook.Sheets("Sheet4").UsedRange
rowC = ThisWorkbook.Sheets("Sheet4").UsedRange.Rows.Count
colC = ThisWorkbook.Sheets("Sheet4").UsedRange.Columns.Count
Dim thisname As String
Dim i As Long
Dim y As Long
Dim x As Long
For i = LBound(this, 1) To UBound(this, 1)
thisname = this(i, 1)
For x = LBound(that, 1) To UBound(that, 1)
If thisname = that(x, 0) Then
Exit For
ElseIf thisname <> that(x, 0) And that(x, 0) = vbNullString Then
that(x, 0) = thisname
Exit For
End If
Next x
Next i
For i = LBound(that, 1) To UBound(that, 1)
thisname = that(i, 0)
For j = LBound(this, 1) To UBound(this, 1)
If this(j, 1) = thisname Then
thisvalue = thisvalue + this(j, 2)
End If
Next j
that(i, 1) = thisvalue
thisvalue = 0
Next i
ThisWorkbook.Sheets("sheet5").Range(ThisWorkbook.Sheets("Sheet5").Cells(1, 1), ThisWorkbook.Sheets("Sheet5").Cells(rowC, colC)).Value2 = that
End Sub
Yay arrays
I need to run Vlookups for data in 2 workbooks. I will open both of my workbooks when running the VBA codes, and I saved both workbooks as .xlsm so they are both macro enabled.
I have no problem using the Vlookup Excel function but I want to run it automatically using VBA code.
Here is the information,
I have 2 workbooks, Book3.xlsm and Book32.xlsm. Book3 is where I want my result to be, as shown in the second picture. The data range varies each month, so I need to loop through the end of the last row.
I have 3 columns in Book3 ID and Type and Result and 2 columns in Book32, ID and Result, and I want to do Vlookup using the ID column in Book3 and get the values in Result columns in Book32. The data are both in Sheet1.
Now my code will run but please look for the first picture where it is not showing the desired result. I can leave the value as #N/A if can't be found but in this case, all the values should be found using Vlookup.
Here is my code,
Sub test()
On Error Resume Next
Dim Res_Row As Integer
Dim Res_Clm As Integer
Dim Table1 As Range
Dim Table2 As Range
Dim cl As Range
Set Table1 = Workbooks("Book3.xlsm").Sheets("Sheet1").Columns("A:C")
Set Table2 = Workbooks("Book32.xlsm").Sheets("Sheet1").Columns("A:B")
Res_Row = Sheet1.Range("C2").Row
Res_Clm = Sheet1.Range("C2").Column
For Each cl In Table1
Sheet1.Cells(Res_Row, Res_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 2, False)
Res_Row = Res_Row + 1
Next cl
MsgBox "Done"
End Sub
How about this code, which avoids the loop and is easier to read \ maintain.
With Workbooks("Book3.xlsm").Sheets("Sheet1")
Dim lRow as Long
lRow = .Range("A" & .Rows.Count).End(xlup).Row
With .Range("C2:C" & lRow)
.FormulaR1C1 = "=Vlookup(RC[-2],[Book32.xlsm]Sheet1!C1:C2,2,0)"
.Value = .Value
End With
End With
Here it is :
Sub test()
On Error Resume Next
Dim Res_Row As Integer
Dim Res_Clm As Integer
Dim Table1 As Range
Dim Table2 As Range
Set Table1 = Workbooks("Book3.xlsm").Sheets("Sheet1").Columns("A:C")
Set Table2 = Workbooks("Book32.xlsm").Sheets("Sheet1").Columns("A:B")
Res_Clm = 3
The loop will be on each rows of the table1.
For Each i In Table1.Rows
If Sheet1.Cells(i.row, 1) = "" Then Exit For
If there is no data ("") in the cell, the program exit the loop
Sheet1.Cells(i.row, Res_Clm) = Application.WorksheetFunction.VLookup(Sheet1.Cells(i.row, 1), Table2, 2, False)
Next i
Next i increment the i of the for each loop.. It is like i = i+1
MsgBox "Done"
End Sub
You use the wrong argument for the first argument of the vlookup.
Also your loop on "cl" would only work on three rows, so I use row argument.
In general, I would adwise to code your vlookup fonction instead of using Application.WorksheetFunction.VLookup. I'm quite sure it is longer.
how to copy & paste the data from one column to another between two sheets of excel workbook ... without overwriting the destination column content?
I am using below code to copy & paste but every time I run it it is overwriting the existed content. I want to be pasted from next row of the column.
Sub DirectCopySample()
Application.ScreenUpdating = False
Sheets("Updating Sheet").Range("A:A").Copy Destination:=Sheets("Sheet1").Range("G:G")
Sheets("Updating Sheet").Range("B:B").Copy Destination:=Sheets("Sheet1").Range("F:F")
Sheets("Updating Sheet").Range("C:C").Copy Destination:=Sheets("Sheet1").Range("B:B")
Application.ScreenUpdating = True
End Sub
Don't copy the entire column. Copy a specific 1-cell-wide range of X rows (where X is your data) and define all your variables based on the current size of the data. For instance if you want to copy column A from sheet1 to the end of column B in sheet2.
Sub CopyColumn()
Dim wsCopy As Worksheet
Set wsCopy = Sheets("<Sheet Name>")
Dim wsPaste As Worksheet
Set wsPaste = sheets("<Sheet Name>")
'/ Much better to make your worksheets variables and then reference those
Dim lngFirstRow As Long
Dim lngFinalRow As Long
Dim lngCopyColumn As Long
Dim lngPasteColumn As Long
Dim rngCopy As Range
Dim rngPasteCell As Range
lngCopyColumn = 1 '/ ("A" Column)
lngDestinationColumn = 2 '/ ("B" Column)
wsCopy.Activate
lngFirstRow = 1
lngFinalRow = Cells(1048576, lngCopyColumn).End(xlUp).Row
'/ Starts at the bottom of the sheet, stops at the first cell with data in it, returns that cell's row
Set rngCopy = Range(Cells(lngFirstRow, lngCopyColumn), Cells(lngFinalRow, lngCopyColumn))
'/ Defines the range between those 2 cells
rngCopy.copy
wsPaste.Activate
lngFinalRow = Cells(1048576, lngPasteColumn).End(xlUp).Row
Set rngpaste = Cells(lngFinalRow + 1, lngPasteColumn)
'/ Pastes to the row 1 cell below the last filed cell in Column B
rngpaste.Paste
End Sub
#Grade 'Eh' Bacon outlined the correct process in his or her comment.
The crux of the issue is finding the size of the ranges you are copying from and pasting to. My current favorite method of doing so is the code snippet below:
copyLastrow = Sheets("Updating Sheet").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
That will find the last non-empty row in your worksheet. So if for some reason column A has 100 rows, B has 200 rows, and C has 300 rows it will return 300 as the last row.
On the paste side of things, you could use the same method and add 1 to it so you paste into the first empty row, but if the columns have different numbers of rows you will end up with many blank rows in the shorter columns before your data is pasted at the bottom.
A work around this is the following code:
pasteLastrowG = Sheets("Sheet1").Range("G" & Rows.Count).End(xlUp).Row + 1
This will start at the bottom of column G and head up until it hits a row with data in it and then add 1 so that you are pasting into the first blank row of the column. You could then create variables for columns H and I that do the same thing.
Putting it all together your code would look something like this in the end:
copyLastrow = Sheets("Updating Sheet").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
pasteLastrowG = Sheets("Sheet1").Range("G" & Rows.Count).End(xlUp).Row + 1
'pasteLastrowH ...
'pasteLastrowI ...
Sheets("Updating Sheet").Range("A2:A" & copyLastrow).Copy Destination:=Sheets("Sheet1").Range("G" & pasteLastrowG)
'Copy and paste B code here
'Copy and paste C code here
I'm trying to create a yearly summary for some of our transfers. Essentially, I have 12 sheets, one for each month of the year, and each entry is given one of four specific "Transfer Rationales" in column L. I need to be able to create a worksheet that gives me a running year-to-date summary based on each transfer rationale.
So say, for example, the transfer rationale I'm looking at is called "Incorrectly Assigned" - I think need to have the summary page show columns G-K of each row where column L is "Incorrectly Assigned" from all twelve month sheets.
I've been looking at VBA code and trying to tweak some to work, but I could use some help!
EDIT:
Obviously it's not working as I need or I wouldn't be here, but I don't have much knowledge about VBA. I have something here where the code is grabbing the entries where column L met the criteria, but it was
a) copying all the columns, and I only need G-K to paste, and
b) was putting the copied rows all in one row in the summary tab, so I could see the data for a split second, and then it would overwrite with the next line and so on until it finally settled on the last entry found.
SECOND EDIT:
So I have a code that now (mostly) works, I've pasted it below and deleted the old code above.
Private Sub CommandButton1_Click()
Dim WkSht As Worksheet
Dim r As Integer
Dim i As Integer
i = 1
For Each WkSht In ThisWorkbook.Worksheets
i = i + 1
If WkSht.Name <> "Incorrectly Assigned" Then
For r = 1 To 1000
If WkSht.Range("L" & r).Value = Sheets("Incorrectly Assigned").Range("A1").Value Then
WkSht.Range("E:L").Rows(r & ":" & r).Copy
Sheets("Incorrectly Assigned").Range("E:L").End(xlUp).Offset(i, 0).PasteSpecial Paste:=xlPasteValues
End If
Next r
End If
Next WkSht
End Sub
The problem now is that it is only grabbing the last match from each worksheet - so say January has four matching entries, it's only pasting the fourth entry, then the next row down it'll paste the last entry from February etc. and then if there's an entry in say November that matches, it'll be pasted in the 11th row from the beginning, rather than each entry being pasted one after another.
Better to create a sub-routine that you call from your "CommandButton1". Then you can call the procedure from more than one location. You can also generalize it by using an input parameter 'transferID' which defines the summary you want.
Private Sub CommandButton1_Click()
Call PrintSummary("Incorrectly Assigned")
End Sub
It will likely need some tweaking to get it how you want, but this should give you some ideas to get you started:
Sub PrintSummary(transferID As String)
Dim ws As Excel.Worksheet
Dim wso As Excel.Worksheet
Dim lrow As Long
Dim rng As Excel.Range
Dim rngo As Excel.Range
Dim cell As Excel.Range
Dim colH As Variant
Dim i As Integer
'// Define columns for output
colH = Array("G", "H", "I", "J", "K")
'// Check for summary sheet (for output)
On Error Resume Next
Set wso = ThisWorkbook.Worksheets("Summary")
On Error GoTo 0
If wso Is Nothing Then
'// Summary worksheet does not exist :/
Exit Sub
Else '// format worksheet for output
'// for example...
wso.Cells.Delete Shift:=xlUp
Set rngo = wso.Range("A1") '// define output start
Set wso = Nothing
End If
'// Loop through worksheets
For Each ws In ThisWorkbook.Worksheets
'// Check for valid worksheet name
Select Case VBA.UCase(ws.Name)
Case "JAN", "FEB" '// and so forth...
Set rng = ws.Range("L1")
Set rng = ws.Range(rng, ws.Cells(Rows.Count, rng.Column).End(xlUp))
For Each cell In rng
If (VBA.UCase(cell.Text) = VBA.UCase(transferID)) Then
'// Print meta data
rngo.Offset(lrow, 0).Value = ws.Name
rngo.Offset(lrow, 1).Value = transferID
'// Print values
For i = 0 To UBound(colH)
rngo.Offset(lrow, i + 2).Value = ws.Cells(cell.Row, VBA.CStr(colH(i))).Value
Next i
'// Update counter
lrow = lrow + 1
End If
Next cell
Case Else
'// Not a month? do nothing
End Select
Next ws
End Sub
You do not need VBA - just refence the cell in the other tab:
SheetName!CellAddress
Precede the cell address with the worksheet name, and follow it with an exclamation point.
If you need VBA, then I have understood your question incorrectly.
EDIT:
Lets start with problem B:
was putting the copied rows all in one row in the summary tab
Lets look at the code you use to paste values:
Sheets("Summary").Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Here you always paste everyting in the same place, in cell A65536 which you offset by one. On every iteration of your loop, the values will be at the same place. Change the Offset(1) to
Offset(0, r)
Now on every iteration you will paste on a different row, because r will be 1, 2, ..., 1000. See MSDN for documentation on Offset. Select a values that accomplished a paste the way you need.
Lets go to the next question:
a) it was copying all the columns
I will edit once the first part works as it should for you.
Sub test4()
Dim LCopyToRow As Long
Dim LCopyToCol As Long
Dim arrColsToCopy
Dim c As Range, x As Integer
On Error GoTo Err_Execute
arrColsToCopy = Array(1, 25, 3) 'which columns to copy ?
Set c = Sheets("MasterList").Range("Y5") 'Start search in Row 5
LCopyToRow = 2 'Start copying data to row 2 in Sheet4
While Len(c.Value) > 0
'If value in column Y ends with "2188", copy to Sheet4
If c.Value Like "*2188" Then
LCopyToCol = 1
For x = LBound(arrColsToCopy) To UBound(arrColsToCopy)
Sheets("Sheet4").Cells(LCopyToRow, LCopyToCol).Value = _
c.EntireRow.Cells(arrColsToCopy(x)).Value
LCopyToCol = LCopyToCol + 1
Next x
LCopyToRow = LCopyToRow + 1 'next row
End If
Set c = c.Offset(1, 0)
Wend
'Position on cell A5
Range("A5").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
This is what I'm using now to pull columns and paste them in the appropriat eorder. I would like two things to happen. First, this macro simply pastes the information; I would like to insert the rows of information since i have formulas at the end of columns is the destination sheets. With just pasting, the info will paste over cells that have formulas in them. Second, the macro above doesn't carry over any borders; I have the destination sheet set up but when it pastes it loses all the borders(even though the MasterSheet and the destination sheets are bordered). Maybe inserting will fix that - I'm not sure. But at any rate I would like to insert instead of paste.
If I understand your question, I think you just need to insert a new row in your destination sheet before doing your paste.
So, in the code below I added 1 line that adds a row before the loop which pastes the columns.
If c.Value Like "*2188" Then
LCopyToCol = 1
'--> Sheets("Sheet4").Cells(LCopyToRow, LCopyToCol).EntireRow.Insert shift:=xlDown
For x = LBound(arrColsToCopy) To UBound(arrColsToCopy)
Let me know if this looks correct, or if I misunderstood you.
UPDATE
To copy formatting, as well, add these 2 lines after the line which copies the values:
c.EntireRow.Cells(arrColsToCopy(x)).Copy
Sheets("Sheet4").Cells(LCopyToRow, LCopyToCol).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone
Here's some tips for you:
This code inserts and copies format for me:
Dim rOrigin As Range, rCopyTo As Range
Set rCopyTo = Selection
Set rOrigin = Range("A2")
rCopyTo.Insert xlShiftToRight, rOrigin.Copy
Application.CutCopyMode = False
from your code, it is very clear that you are only READING values from one sheet and then writing them in another sheet. So to read values generated by formulas, use .TEXT instead of .VALUE
myValue = someRange.Text 'reads the output text by the formula but .TEXT is read only so be careful
Another thing you might do is use the Copy function that is built in.
SomeRange.Copy
then go to the sheet you want to paste and do
Activesheet.PasteValues
or
Activesheet.PasteSpecial (use options here to copy formats and so on)