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
Related
I'm having an issue with copy and pasting from one spreadsheet to another.
I am using the following code:
Sub LoadnH()
Dim NF As Workbook
Dim shtMain As Worksheet
Set shtMain = Worksheets("Main")
Dim filePath As String
Dim strFileName As Variant
strFileName = Application.GetOpenFilename("All Files (*.*), *.*", , "Select File to Import", , False)
shtMain.Range("filePath").Value = strFileName
If strFileName <> False Then
Set NF = Application.Workbooks.Open(strFileName)
Application.CutCopyMode = False
NF.Sheets("Summary").Copy
Application.DisplayAlerts = False
NF.Close False
Dim nH As Worksheet
Set nH = Worksheets("Hedge Data")
nH.Activate
With nH
.Cells.Clear
.Pictures.Delete
.Range("A1").Select
.PasteSpecial xlPasteValues
End With
End If
End Sub
The code errors out at the following point
.PasteSpecial xlPasteValues
The code show a runtime error '1004':
Method 'PasteSpecial' of object'_Worksheet' failed
how can I fix this so this error? Many times when it hits this error excel will crash and shutdown as well.
To Avoid Select and other similar methods you can assign your value of the destination range with the value from your source range.
You are using the Worksheet.Copy method which copies an entire Worksheet not the data in a Range of the worksheet. This will be creating a new copy of your source worksheet each time you run the code but not copying the data of the worksheet to the clipboard. (NB: below demonstrates using the Before parameter which dictates where the Worksheet will be copied to).
The Range.Copy method will copy the defined range's data to the clipboard (unless you specify the destination parameter).
Rather than using Copy/Paste etc. you can assign the value of the destination range with the value from your source range.
These examples below are all for demonstration of the above points and are tested using 2 new workbooks with default names for the workbooks and worksheets.
E.g 1
Sub WorksheetCopyMethod()
Dim SourceWorksheet As Worksheet
Dim DestinationwWorksheet As Worksheet
Set SourceWorksheet = Workbooks("Book1").Sheets("Sheet1")
Set DestinationWorksheet = Workbooks("Book2").Sheets("Sheet1")
SourceWorksheet.Copy DestinationWorksheet
End Sub
The result of this test creates a copy of Sheet1 from Book1 before Sheet1 on Book2.
E.g 2
Sub RangeCopyMethod()
Dim SourceWorksheet As Worksheet
Dim DestinationwWorksheet As Worksheet
Set SourceWorksheet = Workbooks("Book1").Sheets("Sheet1")
Set DestinationWorksheet = Workbooks("Book2").Sheets("Sheet1")
SourceWorksheet.Range("A1").Copy
DestinationWorksheet.Range("A1").PasteSpecial xlPasteValues
End Sub
This example copies cell A1 from Book1 - Sheet1 and pastes it to cell A1 in Book2 - Sheet1.
E.g 3
Sub AvoidSelectMethod()
Dim SourceWorksheet As Worksheet
Dim DestinationwWorksheet As Worksheet
Set SourceWorksheet = Workbooks("Book1").Sheets("Sheet1")
Set DestinationWorksheet = Workbooks("Book2").Sheets("Sheet1")
DestinationWorksheet.Range("A1").Value = SourceWorksheet.Range("A1").Value
End Sub
This example assigns the Value property of A1 from Book1 - Sheet1 to cell A1 in Book2 - Sheet1. It's the same outcome as E.g 2 but avoids using Select, Copy & Paste etc. This method is much faster and generally less error prone than the 2nd example.
Depending on your environment, the first example may be the easiest and quickest method.
I have a workbook with two sheets.
First is called "Forma"
Second is called "Prices"
I go to Forma, with some VBA shapes I choose a product category. I tag this category name in A1 cell of sheet Prices and then filter products according to this category and then copy filtered ones in Forma again.
Because of activating and deactivating sheets the procedure is working but it is blinking screens between activations. Any better way?
That is a part of my code:
With ActiveSheet
range("j7: m30").ClearContents
End With
'Tag the category in Prices Table
ThisWorkbook.Sheets("Prices").Cells(1, 1).Value = "CategoryName.ex.Computers"
'Filtering and selecting products comparing A1 with Column 3 Categories
Worksheets("Prices").Activate
range("A1:K300").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=range("a1").Value
'Copy filtered in Forma Sheet
Dim DbExtract, DuplicateRecords As Worksheet
Set DbExtract = ThisWorkbook.Sheets("Prices")
Set DuplicateRecords = ThisWorkbook.Sheets("Forma")
DbExtract.range("D3:f5000").SpecialCells(xlCellTypeVisible).Copy
DuplicateRecords.Cells(7, 10).PasteSpecial
Copy Filtered Range
Not activating and not selecting will increase performance.
Turning off Application.ScreenUpdating will stop the screen from 'blinking'.
Using variables will increase readability.
Something like the following code could put you on the right track.
The Code
Option Explicit
Sub copyCategory()
Const Criteria As String = "CategoryName.ex.Computers"
Dim wb As Workbook
Set wb = ThisWorkbook
Dim src As Worksheet
Set src = wb.Worksheets("Prices")
Application.ScreenUpdating = False
If src.AutoFilterMode Then
src.AutoFilterMode = False
End If
src.Range("A1").Value = Criteria
src.Range("A1:K300").AutoFilter Field:=3, _
Criteria1:=Criteria
Dim dst As Worksheet
Set dst = wb.Worksheets("Forma")
dst.Range("J7: M30").ClearContents
src.Range("D3:F300").SpecialCells(xlCellTypeVisible).Copy dst.Range("J7")
' If you need some special pasting then rather use the following 3 lines.
'src.Range("D3:F300").SpecialCells(xlCellTypeVisible).Copy
'dst.Range("J7").PasteSpecial
'Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data copied.", vbInformation, "Success"
End Sub
The below code opens up folders and allows me to choose what document I want to be the source, it then opens it behind screen and works when copying sheets.
I tried to change the code to copy rows based on column G having "140. On Hold" in it, then pasting each of these rows into the active workbook.
UPDATED CODE
Sub GetBIDFileCopyData()
Dim Fname As String
Dim SrcWbk As Workbook
Dim DestWbk As Workbook
Dim C As Range
Dim J As Long
Set DestWbk = ThisWorkbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fname = "False" Then Exit Sub
Set SrcWbk = Workbooks.Open(Fname)
SrcWbk.Sheets("ChangeDetails").Rows(C.Row).Copy DestWbk.Sheets("Bids On-Hold 29.01.20").Rows(J)
J = 1
For Each C In SrcWbk.Range("G2:G200")
If C.Value = "140. On Hold" Then
J = J + 1
End If
Next C
SrcWbk.Close False
End Sub
As #SiddharthRout commented, the best way to copy/paste based on a specific criteria, is to use a filter. Comments are given in the code below. I did not test your code to open a file.
Dim Fname As String, SrcWbk As Workbook, DestWS As Worksheet, Rng As Range 'Assign your variables
'Set your destination worksheet
Set DestWS = ThisWorkbook.Sheets("Bids On-Hold 29.01.20")
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fname = "False" Then Exit Sub
Set SrcWbk = Workbooks.Open(Fname)
'Set the range you want to filter on your scorce worksheet
Set Rng = SrcWbk.Sheets("ChangeDetails").Range("G2:G200")
'Since you used only column G for your range, use the copy line below.
'But if you use the full range of the worksheet, e.g. Range("A1:Z200"),
'you could use field:=7 in the filter, and remove .EntireRow from the copy line
With Rng
'Filter Column G
.AutoFilter field:=1, Criteria1:="140. On Hold"
'use Resize and Offset to copy the visible data
'If Row 2 has data and is not a header row, you should use Row 1, in Rng
'Offset and Resize adjusts the range so the top row(Header) is not copied
Rng.Resize(Rng.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
DestWS.Range("A1").PasteSpecial xlPasteValues
'Clear the filter
.AutoFilter
End With
The two lines
SrcWbk.Sheets ("ChangeDetails")
DestWbk.Sheets ("Bid Delivery Report")
do not compile. What are they supposed to do?
You try to copy the rows with the following code:
SrcWbk.Rows(C.Row).Copy DestWbk.Rows(J)
but you are missing a reference to the worksheet.
So maybe you are looking for:
SrcWbk.Sheets("ChangeDetails").Rows(C.Row).Copy DestWbk.Sheets("Bid Delivery Report").Rows(J)
or better use varables for your sheets.
I would like to copy a range of cells in a closed notebook that does not have a static set of rows. I would like to copy it into an active workbook.
I am trying to dynamically copy all entries under the column of F from file 'test.xlsx' from the 'exception' worksheet. The macro runs without issue if there I use static referencing instead. Here is the code that I am running, it gives me a runtime error for the line that copies the data.
Sub GetClassID()
Dim App As New Excel.Application
Dim wsActive As Worksheet
Set wsActive = ThisWorkbook.ActiveSheet
Dim wbImport As Workbook
Set wbImport = App.Workbooks.Open(Filename:="C:\Test.xlsx",
UpdateLinks:=True, ReadOnly:=True)
wbImport.Worksheets("Exception").Range("F2",Range("F2").end(xldown)).Copy
wsActive.Range("A2").PasteSpecial Paste:=xlPasteFormats
wsActive.Range("A2").PasteSpecial Paste:=xlPasteValues
App.CutCopyMode = False
wbImport.Close SaveChanges:=False
App.Quit
End Sub
Error I get is runtime erorr '1004': Interface not registered
Assuming you run this in an Excel VBA? You don't need to open the other workbook as an Excel.Application, just remove the app out of it and open the workbook normally:
Sub GetClassID()
Dim wsActive As Worksheet
Set wsActive = ThisWorkbook.Sheets("Another Sheet Name")
Dim wbImport As Workbook
Set wbImport = Workbooks.Open(Filename:="C:\Test.xlsx", UpdateLinks:=True, ReadOnly:=True)
With wbImport.Worksheets("Exception")
.Range("F2", .Range("F2").End(xlDown)).Copy
End With
wsActive.Range("A2").PasteSpecial Paste:=xlPasteFormats
wsActive.Range("A2").PasteSpecial Paste:=xlPasteValues
App.CutCopyMode = False
wbImport.Close SaveChanges:=False
App.Quit
End Sub
In my experience, the most effective way to copy a dynamic range is to create a variable as an integer and assign the row of the last cell to be copied (or column if needing to select a row of data across to a certain point. I usually accomplish it with something like this:
Dim R as Integer
With ThisWorkbook.Worksheets
R = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Then you can plug in 'R' for the row number in a range to make it dynamic each time the macro is ran. For instance: .Range("A1:A" & R).Copy would copy the used range in Column A. It also makes it really easy to reference the last row for loops and such continuously throughout your code. Hope this helps!
I want to copy the columns from one excel to another excel based on the column header name. i have two excel file called "Source" and "Destination" as shown below in the image:
Source.xls
Destination.xls
i wanted to copy all the columns from source file and paste into to in the destination excel file based on the header file i.e to the yellow shaded columns .Because there are some formula defined in the destination file as shown and it calculates the values from the source file column.
I have tried the basic copy and paste columns. Though it works , it requires lot of manual interventions.
sample piece of code:
src.Range("A:A").Copy Destination:=trg.Range("A1")
src.Range("B:B").Copy Destination:=trg.Range("E1")
src.Range("C:C").Copy Destination:=trg.Range("I1")
i would expect something like to lookup the column header name from source file and destination file and if the names are matched , then it will paste the whole columns in the destination file. As i am very new to excel , can anyone help to solve this through VBA scripts
Please try this.
Option Explicit
Public Sub SpecificColCopy()
Dim Wbs As Workbook
Dim Wbd As Workbook
Dim Wbm As Workbook
Dim RealLastRow As Long
Dim SourceCol As Long
Dim Cell As Range
Dim sourceWS As Worksheet, targetWS As Worksheet
Dim MacroWS As Worksheet
Dim SourceHeaderRow As Long: SourceHeaderRow = 1
Dim SourceCell As Range
Dim TargetHeader As Range
Application.DisplayAlerts = False
On Error Resume Next
Set Wbm = ThisWorkbook
Set MacroWS = Wbm.Worksheets("Sheet1")
Set Wbs = Workbooks.Open("C:\mydirb\Source.xlsx") 'workbook needs to be closed state
Set sourceWS = Wbs.Worksheets("Sheet1")
Set Wbd = Workbooks.Open("C:\mydirb\Destination.xlsx") ''workbook needs to be closed state
Set targetWS = Wbd.Worksheets("Sheet1")
Set TargetHeader = targetWS.Range("A1:N1")
On Error GoTo 0
sourceWS.Activate
For Each Cell In TargetHeader
If Cell.Value <> "" Then
Set SourceCell = Rows(SourceHeaderRow).Find _
(Cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not SourceCell Is Nothing Then
SourceCol = SourceCell.Column
RealLastRow = Columns(SourceCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If RealLastRow > SourceHeaderRow Then
Range(Cells(SourceHeaderRow + 1, SourceCol), Cells(RealLastRow, _
SourceCol)).Copy
targetWS.Cells(2, Cell.Column).PasteSpecial xlPasteValues
End If
End If
End If
Next
MacroWS.Activate
Wbs.Save
Wbd.Save
Wbs.Close
Wbd.Close
Application.DisplayAlerts = True
End Sub
[![Souce_destination][1]][1]