I'm trying to copy data from one workbook into another workbook that is build as a survey.
In the survey form, we are using ActiveX controls for combo boxes and check boxes. I left two samples of ways I have tried (and failed).
Sub TransferData()
Set Source = Workbooks.Open("FromHere.xlsm")
Set qstnr = Workbooks.Open("ToHere.xlsx")
' Banner Form Classification
Source.Activate
Cells(8, 2).Copy
qstnr.Activate
Set Cbo_Classification = qstnr.OLEObjects("Cbo_Classification")
With Cbo_Classification.Object
.Text = "Not sure what to do here"
End With
' Reporting Organization
Source.Activate
Cells(9, 2).Copy
qstnr.Activate
'ActiveSheet.OLEObjects("Cbo_RptOrg").PasteSpecial Paste:=xlPasteValues
End Sub
EDIT: I have been able to get the object to be pasted into when working in the same workbook with the copy below. I don't understand why it's not successful when working outside the document.
Sub TransferObjects()
Dim wbk As Workbook: Set wbk = Workbooks.Open("CopyFrom.xlsm")
Dim tmplt As Workbook: Set tmplt = Workbooks.Open("CopyTo.xlsx")
Dim qstnr As Worksheet
Set qstnr = tmplt.Sheets("Sheet1")
qstnr.OLEObjects("Cbo_RptOrg").Object.Value = Range("K12").Value
End Sub
' Reporting Organization
Source.Activate
Dim Cbo_RptOrg As Variant
Cbo_RptOrg = Cells(2, 9).Value
qstnr.OLEObjects("Cbo_RptOrg").Object.Value = Cbo_RptOrg
This ended up working. Using a variable as suggested.
Related
trying to do in another focus with the window from the workbook from first trying to do in another focus with the window from the workbook from first
Sub Update_DHL()
Workbooks.Open Filename:=trk
Workbooks.Open Filename:=stp
Workbooks.Open Filename:=dhl
Windows(stp).Activate
Workbooks(stpfile).Activate
Range("B2").Select
ActiveCell.Formula = _
"Hi"
Range(Cells(2, 2), Cells(2, 2)).Copy
'Range(Cells(3, 2), Cells(65536, 45)).Select
'Selection.ClearContents
'Range(Cells(3, 47), Cells(65536, 74)).Select
'Selection.ClearContents
' Set wb = Workbooks("VMW Macro.xlsm") 'Name of the workbook you are copying from
' Set ws = wb.Sheets("Extract") 'Name of sheet you are copying
' DateStamp = Format(Now(), "mm-dd-yyyy hhmmss")
End Sub
Make sure you define variables for your workbooks and worksheets properly. You can then use them for your Range and Cells objects to specify in which workbook and worksheet they are. This way you don't need .Activate or .Select because the code even works if the workbook has no focus.
Make sure in your entire code there is no Range and Cells object without a workbook and worksheet specified. Either by using a variable like shown below. Or directly like ThisWorkbook.Worksheets("Sheet1").Range(…).
You only need to .Activate or .Select if you want to focus it for the user. You never need to do this to make VBA work properly (VBA can work with non-focused workbooks/worksheets).
Option Explicit
Sub Update_DHL()
'open your workbooks
On Error GoTo ERR_WB_OPEN
Dim wbTrk As Workbook
Set wbTrk = Workbooks.Open(Filename:=[truckfilePath])
Dim wbStp As Workbook
Set wbStp = Workbooks.Open(Filename:=[stopfilePath])
Dim wbDhl As Workbook
Set wbDhl = Workbooks.Open(Filename:=[dhlfilePath])
On Error GoTo 0
'define in which worksheet in those workbooks you want to work
Dim wsTrk As Worksheet
Set wsTrk = wbTrk.Worksheets("SheetName")
Dim wsStp As Worksheet
Set wsStp = wsStp.Worksheets("SheetName")
Dim wsDhl As Worksheet
Set wsDhl = wsDhl.Worksheets("SheetName")
'now work with those worksheets directly (no activate or select needed!)
wsStp.Range("B2").Formula = "=IF(SUMIF('Route Master.xls'!$C$7:$C$65536,$A2,'Route Master.xls'!$Q$7:$Q$65536)>0,TRUE,FALSE)"
wsStp.Range("B2").Copy
wsStp.Range(wsStp.Cells(2, 2), wsStp.Cells(EndRow2, 2)).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' note this code does not work because `EndRow2` is nod defined
'select and activate a specific workbook/worksheet
'you do this ONLY if you want to focus it for the USER. Never do this for VBA instead work directly with the worksheets as shown above.
wbDhl.Activate
wsDhl.Select
Exit Sub
ERR_WB_OPEN:
MsgBox "One of the files could not be loaded.", vbCritical
End Sub
Don't forget to close your workbooks wbDhl.Close SaveChanges:=True/False otherwise they stay open.
See below. You can reference the workbook directly as pointed out by BigBen. In code, you never need to select ranges or activate workbooks/worksheets. You just need to reference them directly.
Notice I also added explicit declaration of types.
Dim a, b As Long
The line above will declare a as a variant and b as long
Sub Update_DHL()
Dim trk As Workbook, stp As Workbook, dhl As Workbook, wb As Workbook, wbNew As Workbook
Dim ws As Worksheet
Dim stpfile As String, DateStamp As String, strFolderpath As String
Dim EndRowTrk As Long, EndRowStp As Long, EndRowDHL As Long
Dim fileExplorer As FileDialog
Set dhl = [dhlfilePath]
Set trk = [truckfilePath]
Set stp = [stopfilePath]
stpfile = stp
Workbooks.Open Filename:=trk
Workbooks.Open Filename:=stp
Workbooks.Open Filename:=dhl
With Workbooks(stpfile).Worksheets(1)
.Range("B2").Formula = "Hi"
End With
End Sub
I am currently setting new designs Excel files to fit better on mobile devices. But the old designs files are also needed to some clients and I need to export the data to old design files from new design files.
Old design file contains 4 Sheets. After exporting the data I want to select Cell A1 on all sheets. But I was only able to Range("A1").Select or Cells(1,1).Select on Sheets(1) only. If I set on other sheets I got "Run Time Error '1004': Select method of Range Class failed". Below are the VBA Codes along with some comments. Please help.
Set Old_CV = Application.Workbooks.Open(Old_File_Path)
ThisWorkbook.Worksheets("Data_Import").ListObjects("tbl_part2").DataBodyRange.Copy
wsTarget = ThisWorkbook.Worksheets("Data_Import").Range("rng_CV_Part2_Old")
Old_CV.Worksheets(wsTarget).Range(wsSource.Range("rng_P2_A1_Start_Old").Value).PasteSpecial xlPasteValuesAndNumberFormats
Old_CV.Activate
Old_CV.Sheets(1).Cells(1, 1).Select 'This line works even without Old_CV.Active
Old_CV.Sheets(2).Cells(1, 1).Select 'This and below lines don't work even with Old_CV.Active and showing Runtime Error
Old_CV.Sheets(3).Cells(1, 1).Select
Old_CV.Sheets(4).Cells(1, 1).Select
Please Help.
Activate & Select
Select and Activate are usually to be avoided, but this task you cannot do without them.
A good idea is to do this from the last to the first worksheet, so the first stays selected (activated).
In the first two examples you are activating each worksheet before selecting the cell, so you need not activate the workbook.
In the third example you have to activate the workbook first and at the end you have to select the first worksheet 'to get rid of the group'.
The out-commented lines where used to create critical working examples in which first another workbook is active.
The Code
Option Explicit
Sub test1()
' Dim Old_CV As Workbook
' Set Old_CV = ThisWorkbook
' Workbooks("Book2").Activate
' ActiveSheet.Cells(1, 1).Value = 1
Old_CV.Worksheets(4).Activate
Old_CV.Worksheets(4).Cells(1, 1).Select
Old_CV.Worksheets(3).Activate
Old_CV.Worksheets(3).Cells(1, 1).Select
Old_CV.Worksheets(2).Activate
Old_CV.Worksheets(2).Cells(1, 1).Select
Old_CV.Worksheets(1).Activate
Old_CV.Worksheets(1).Cells(1, 1).Select
End Sub
Sub test2()
' Dim Old_CV As Workbook
' Set Old_CV = ThisWorkbook
' Workbooks("Book2").Activate
' ActiveSheet.Cells(1, 1).Value = 2
Dim n As Long
For n = 4 To 1 Step -1
Old_CV.Worksheets(n).Activate
Old_CV.Worksheets(n).Cells(1, 2).Select
Next n
End Sub
Sub test3()
' Dim Old_CV As Workbook
' Set Old_CV = ThisWorkbook
' Workbooks("Book2").Activate
' ActiveSheet.Cells(1, 1).Value = 3
Old_CV.Activate
Old_CV.Worksheets(Array(1, 2, 3, 4)).Select
ActiveSheet.Cells(1, 3).Select
Old_CV.Worksheets(1).Select
End Sub
I got about 90 Powerqueries in my Excel workbook, some of them with quite extensive code. In order to review the code and check the queries' logic, I want the code of all queries to be printed into a worksheet (rather then opening each query and the Advanced Editor and copying and pasting the code).
Couldn't find anything in the Internet. Also tried recording a macro but it doesn't record anything that's done in the Query Editor. Also saved the Excel file as .zip and searched for anything helpful in the xml-files - no success.
Does anyone have an idea?
As with all collections in VBA, you can access the elements by name or by index.
The following code adds a new sheet "Queries" at the end of a workbook and lists all queries.
Sub ListQueries(Optional wb As Workbook = Nothing)
If wb Is Nothing Then Set wb = ActiveWorkbook
Dim ws As Worksheet
wb.Sheets.Add after:=wb.Sheets(wb.Sheets.Count)
Set ws = ActiveSheet
With ws
.Name = "queries"
.Range("A1") = "Name"
.Range("B1") = "Query"
.Range("B:B").ColumnWidth = 150
Dim i As Long
For i = 1 To wb.Queries.Count
.Range("A" & i + 1) = wb.Queries(i).Name
.Range("B" & i + 1) = wb.Queries(i).Formula
Next i
End With
End Sub
I'm having an issue with the above: I am using the answer provided, but still hitting an object error. Can you see what i'm missing? I hit the errror at "Cash_Sheet.Range("C8").PasteSpecial xlPasteValues"
`Sub Refresh_Cash()
Dim Morning_Export As Workbook
Dim Cash_Sheet As Worksheet
'Open MorningExport cash workbook
Set Morning_Export = Workbooks.Open(Range("varMornExpPath"))
'Copy cash from Morning_Export_Settlement_Cas tab:
Morning_Export.Sheets("Morning_Export_Settlement Cas").Range("A1:AR5000").Copy
'Set the sheet in this file to paste to:
Set Cash_Sheet = ThisWorkbook.Worksheets("Cash")
'Clear prior data from EOD_Check
Cash_Sheet.Range("rngRefreshPFMExp").ClearContents
'EVERYTHING WORKS UP UNTIL THIS POINT BUT THEN FAILS HERE
Cash_Sheet.Range("C8").PasteSpecial xlPasteValues
'Close MorningExport book:
Morning_Export.Close
End Sub
Sub Refresh_Cash()
Dim wb As Workbook: Set wb = Workbooks.Open(Range("varMornExpPath"))
Dim cs As Worksheet: Set cs = ThisWorkbook.Sheets("Cash")
cs.Range("rngRefreshPFMExp").ClearContents
wb.Sheets("Morning_Export_Settlement Cas").Range("A1:AR5000").Copy
cs.Range("C8").PasteSpecial xlPasteValues
wb.Close
End Sub
Instead of using copy\paste you can directly write the values from one range in to another. This works much faster on large data sets because it doesn't have to copy twice. It also results in cleaner code.
Public Sub Refresh_Cash()
Dim Morning_Export As Workbook
Dim Cash_Sheet As Worksheet
'Open MorningExport cash workbook
Set Morning_Export = Workbooks.Open(ActiveSheet.Range("varMornExpPath"))
'Set the sheet in this file to paste to:
Set Cash_Sheet = ThisWorkbook.Worksheets("Cash")
' Set the values directly
Cash_Sheet.Range("C8") = Morning_Export.Sheets("Morning_Export_Settlement Cas").Range("A1:AR5000")
'Close MorningExport book:
Morning_Export.Close
End Sub
SEE: Copy/PasteSpecial vs Range.Value = Range.Value
I have a report which is used to import data relating to jobplans and then creates graphs and stats based on the data. Calculations and graphs are based on tables and the tables are populated by VBA - user selects the file and then VBA checks it matches the expected file format and put everything in the right place.
HOWEVER, the pastespecial part of the code does not paste everything correctly. Specifically there are a number of columns with datevalues and when pasted some of them (not one column or particular rows but seemingly random cells) are not formatted as dates when pasted and therefore are not captured in formulas when I look for job within particular timeframes.
In the source file the all data is 100% saved as a datevalue (if I put a filter on the data, it is all grouped by year and can be expanded to month/day/time + if I use a test cell to do add 1 to the cells that the next date is shown). Once pasted into target sheet then some is still a datevalue but some appears to be text and showing as dd/mm/yyyy hh:mm but being missed from calculation. On these cells if I go onto them press F2 and then Enter then the cell changes to a datevalue (realigns to the right and then gets included in daterange formulas).
Here is the code:
Public Sub importdata()
Dim wb1, wb3 As Workbook
Dim ws1, ws3 As Worksheet
Dim lrow As Long
Dim WOtable As ListObject
Dim searchcell As Range
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Dashboard")
Set WOtable = ws1.ListObjects("workorder")
WOfile = Application.GetOpenFilename(FileFilter:="Excel Files (*.CSV),*.CSV", Title:="Select Workorder Extract To Be Opened",MultiSelect:=False)
If WOfile = False Then Exit Sub
Set wb3 = Workbooks.Open(WOfile)
Set ws3 = wb3.Sheets(1)
ws3.Range("M:M, O:O, Q:Q").EntireColumn.Delete
If ws3.Range("A1").Value = "jobnumber" And ws3.Range("B1").Value ="jobdesc" And etc etc Then
lrow = ws3.Range("A1").End(xlDown).Row
ws3.Range("A2:O" & lrow).Copy
WOtable.DataBodyRange(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Else: MsgBox ("File selected to import workorder information was not in expected format, please check the file and retry.")
End If
wb3.Close False
End Sub
I have tried to add the following line before copying to force it based on something I saw on google but to no avail:
ws3.Columns("E:K").NumberFormat = "DD/MM/YYYY HH:MM:SS"
Thanks for any help
As discussed in comments, an example usage of pushing the data into a variant array and then pasting it to the destination. A few comments:
Always state what type you want for each variable, comma separated variables on the same line don't all take the last type.
Use with statements to keep code slightly cleaner and reduce the amount of references excel needs to resolve.
As you didn't clear the contents of the table (merely overwrote them) I replicated this behaviour in the code as I assume it is intended.
Edited sub:
Public Sub importdata()
Dim wb1 As Workbook, wb3 As Workbook
Dim ws1 As Worksheet, ws3 As Worksheet
Dim WOtable As ListObject
Dim varTMP As Variant
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Dashboard")
Set WOtable = ws1.ListObjects("workorder")
WOfile = Application.GetOpenFilename(FileFilter:="Excel Files (*.CSV),*.CSV", Title:="Select Workorder Extract To Be Opened", MultiSelect:=False)
If WOfile = False Then Exit Sub
Set wb3 = Workbooks.Open(WOfile)
Set ws3 = wb3.Sheets(1)
With ws3
.Range("M:M, O:O, Q:Q").EntireColumn.Delete
If .Range("A1").Value = "jobnumber" And .Range("B1").Value ="jobdesc" And etc etc Then
'load data into variant array
varTMP = .Cells(1, 1).CurrentRegion
'If you want to do any data manipulation on the array, do it here
'Paste array
End With
With WOtable.DataBodyRange
Range(.Cells(1, 1), .Cells(0 + UBound(varTMP, 1), 0 + UBound(varTMP, 2))) = varTMP
End With
Else
MsgBox ("File selected to import workorder information was not in expected format, please check the file and retry.")
End If
wb3.Close False
End Sub