Copying Data from External workbook based on headers not in order to another workbook - vba

I hope this is the right place to ask this question as I am on the verge of going crazy. I am so rusty and I have zero experience with VBA (only with C++, java)
The problem:
I am trying to copy data from one workbook to another.
Lets say I have a workbook (called DATA) with several worksheets filled with data. Each column of data has a unique heading (all headings on the same row).
On the other hand I have another workbook (called REPORT) with one worksheet that contains only the heading of the data (in one row). They are not in the same order as in DATA workbook. For example I have 3 headings in REPORT worksheet that can be found in different worksheets in DATA workbook.
I need to loop through all the worksheets in the DATA workbook and copy paste the whole column to the REPORT worksheet when the same heading is found.
This image may help to understand. Explanation
Thanks ALOT for your help in advance. I have searched alot for this code but found similar stuff but didnt manage to understand any .
First attempt at doing it, but getting an error of Run-time error '1004'.
Any help?
Dim MyFile As String
Dim ws As Worksheet
''Workbook that contains one worksheet with all the headings ONLY NO DATA
Dim TargetWS As Worksheet
Set TargetWS = ActiveSheet
Dim TargetHeader As Range
''Location of Headers I want to search for in source file
Set TargetHeader = TargetWS.Range("A1:G")
''Source workbook that contains multiple sheets with data and headings _
not in same order as target file
Dim SourceWB As Workbook
Set SourceWB = Workbooks("Source.xlsx")
Dim SourceHeaderRow As Integer: SourceHeaderRow = 1
Dim SourceCell As Range
''Stores the col of the found value and the last row of data in that col
Dim RealLastRow As Long
Dim SourceCol As Integer
''Looping through all worksheets in source file, looking for the heading I want _
then copying that whole column to the target file I have
For Each ws In SourceWB.Sheets
ws.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
Next

Your question didn't specify what part of the problem you're actually stuck on, so I'll assume you don't know how to start. Note that nobody on here is going to provide you with the full working solution to your problem - that's upto you to figure out.
A few tips to get you to start working:
The first question you're going to ask yourself with problems involving multiple workbooks is typically going to be which workbook am i going to attach my macro to?
In your case, the REPORT Workbook looks like a saner option, since you probably want someone to be clicking on something in the report in order to generate it. You could also argue the other way around though.
Once you have chosen where to put your VBA, you have to establish a reference to the other workbook.
You either have to load the other Excel file from disk using Workbooks.Open, or have both Workbooks be open at the same time in your Excel Instance, which I'd recommend for you because it's easier. In this case simply establish the reference using the Workbooks object.
Dim exampleRefToDATA As Workbook: Set exampleRefToDATA = Workbooks("data.xlsx") ' or index
Then, cycle through each Worksheet
using something like For Each ws As WorkSheet In exampleRefToDATA.WorkSheets as your For Loop
In that Loop, loop through the first column using something like
For Each allName As Range In ws.Range(... for you to figure out ...)
In this Loop, you'll have to look if that name is in your REPORTS sheet by doing another loop like
For Each thisName As Range in Range(... seriously, there's enough on stackoverflow on how to properly iterate over the used range of a row ...)
Note how this Range() call is Equivalent to ActiveWorkbook.ActiveWorkSheet.Range, which is your Reports sheet.
Then just check for equality and copy the row over if necessary. Again, copying a row has also been covered here before.
Hope this was helpful for you.

Related

Wait until application.run is completed

I'm trying to write a macro on one file that opens another workbook, runs a macro to get some data, copies the data into the first workbook and closes the second workbook.
I have however encountered a problem because it seems like the selection of the range is executed while the macro in the second workbook is still running and therefore selects the entire column:
i.e. the ws2.Range(StartCell, ws2.Cells(LastRow, "A")).Select string in the code below selects the whole column, and not just the cells where there is data.
'run macro in IB API file to get portfolio data
Application.Run "TwsDde.xls!Sheet15.subscribeToPorts"
'select data in column A from IB API file
Dim LastRow As Long
Dim StartCell As Range
Set StartCell = Range("A8")
LastRow = ws2.Cells(ws2.Rows.Count, StartCell.Column).End(xlDown).Row
ws2.Range(StartCell, ws2.Cells(LastRow, "A")).Select
Has anyone encountered this problem before or has any ideas on how to solve it?
Your calculation of LastRow is wrong. It should be xlUp instead of xlDown.

Excel 2013: Use macro to copy and subsequently add data from one sheet to another within same workbook

I have used the various methods pointed out in this forum and none seem to work, so I will try to be more specific.
I have a workbook called LIBRARY.xlsm.
This workbook contains two worksheets: CALCULATOR and CUTS.
The worksheet CALCULATOR contains two tables: INPUT and OUTPUT.
I enter data into INPUT, values are calculated and automatically entered into OUTPUT.
I create a button below OUTPUT with macro to copy data in OUTPUT to worksheet CUTS.
I enter new data into INPUT, which then updates OUTPUT.
Now I want to copy this new data to CUTS without overwriting or deleting previous data.
Since this project is divided into 5 sections, I should end up with five tables in the worksheet CUTS that I can then print out.
The INPUT table encompasses cells A1:M31, which does not matter (I’m not copying this).
The OUTPUT table occupies cells O6:S26. This is the data that needs to be copied.
Placement into worksheet CUTS can start at cell A1 (which means the table will have the range A1:E20). I would like to skip a column and then place the next data set. Thus, the next data set should begin at G1 (G1:K20), then at M1:Q20 and so forth). Maybe only go three tables across and then start next three below (separated by row).
Here is the code tried to use. Problem is, it does not retain the values and it overwrites the previous data.
Sub Create_CUTS ()
Dim sourceSheet As Worksheet
Dim sourceRange As Range
Dim sourceRows As Integer
Set sourceSheet = Worksheets("CALCULATOR")
sourceRows = WorksheetFunction.CountA(sourceSheet.Range("A:A"))
Set sourceRange = sourceSheet.Range("O6:S26" & sourceRows)
Dim targetSheet As Worksheet
Dim targetRange As Range
Dim targetRows As Integer
Set targetSheet = Worksheets("CUTS")
targetRows = WorksheetFunction.CountA(targetSheet.Range("A:A"))
Set targetRange = targetSheet.Range("A" & targetRows + 1 & ":A" & targetRows + 1 + sourceRows)
sourceRange.Copy Destination:=targetRange
End Sub
Thank you, everyone
-Grumps
There are a few ways to do this. The easiest is probably to just reference the usedrange of the target sheet to know where you left off with the last paste.
lastUsedRow = targetSheet.UsedRange.Rows.Count
lastColumnUsed = targetSheet.UsedRange.Columns.Count
Then you just add a column or row and paste the table in the new location. If the column count is 22 or greater, add a row and paste at "A" and the lastUsedRow + 2. There is some potential for this to be wrong if the sheets are saved with cells that are empty, but excel reads them as "used" (somehow people I work with manage to do this all the time, I don't even know how they do it). It sounds like this is something that users won't be manipulating, so I wouldn't think that would be a problem, but if it is a possible problem for you, you can use a loop to find the next empty cell instead of using the built in "usedrange" collection.

Copy/Paste variable dataset between workbooks without clipboard

I've been trying to optimize some of my coding and managed to cut and speed it up a lot. However there are some things that are still quite clunky (and me still a noob). Backstory is that my code is opening source and target files, copies a lot of data of variable length, closes source and then does a lot of operations and finally saves target file.
One of the things Id like is to do if possible is a direct copy of data without using clipboard, activating workbooks, selecting sheets (whatever of this is possible to pack into more efficient code that I am currently having)
Windows("SOURCE.xlsm").Activate
Sheets("Data").Select
Range("A2:AX10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("TARGET.xlsm").Activate
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Is it possible to do a selection (A2:AX10 and all the way down to last row) in SOURCE file-Data sheet and directly copy it to TARGET file-Data sheet cell A2 without using clipboard.
The reason why I use A2:AX10 and then selection down is because I have a lot of blank cells in the whole data set and this way I get entire data.
I would like to be able to to that selection and use it as a range in this line
Workbooks(“SOURCE”).Worksheets("Data").Range(“A2:AX10 & ALLTHEWAYDOWN”).Copy _Workbooks(“TARGET”).Worksheets("Data").Range(“A2")
I was trying to solve this but I dont end up with desired result. When I try doing selection and setting as range then both trying copy range with activitng workbooks and in the direct copy mode I get 1004 error.
Is it possible to optimize this chunk and make it work. It would improve a lot of my VBA.
Thanks,
You need something like this:
With Workbooks("SOURCE.xlsm").Sheets("Data")
.Range("A2:AX10", .Range("A2:AX10").End(xlDown)).Copy Workbooks("TARGET.xlsm").ActiveSheet.Range("A2")
End With
You could probably also use CurrentRegion rather than End(xlDown
You can set one range's values (the range where you would want to paste values) equal to a source range's values (the range which you would previously have copied).
Sub paste_values()
Dim wb_A As Workbook, ws_A As Worksheet
Dim wb_B As Workbook, ws_B As Worksheet
Dim last_row As Long
Set wb_A = ThisWorkbook
Set ws_A = wb_A.Sheets(1)
Set wb_B = Workbooks("WorkbookB")
Set ws_B = wb_B.Sheets(1)
With ws_A
last_row = .Range("A" & .Rows.Count).End(xlUp).Row
End With
ws_B.Range("A2:AX" & last_row).Value = ws_A.Range("A2:AX" & last_row).Value
End Sub
This code is setting the new range's values equal to the original range. It prevents the need to activate sheets or workbooks, whilst also copying data to a range without filling the clipboard.
I would also recommend using last_row = .Range("A" & .Rows.Count).End(xlUp).Row to find the last row of your data. Although you do need to ensure you use this on a column which you know contains continuous data.

Excel VBA For each sheet get contents of a row and put in an array

I have a current project that requires me to open an excel doc, figure out what format the doc is in (what the "headers" are as A:A contents), then figure out if it adheres to a new document layout format, and convert necessary data to conform to the new format.
I have to do this for thousands of files, so I want to automate as much of the discovery portion as possible, and plan to only need to write a few one-off solutions for some content types (docs with specific data which needs to be preserved as an exception to the new formatting).
That's the context for what I'm trying to do. I've gotten to the point of trying to populate an array of the contents of row A:A in each sheet, but my ReDim statement is failing as I guarantee I'm doing something wrong with it.
Here's what I've got from the point where I get into the sheet:
For Each Sht In SourceWorkbook.Sheets
Sht.Activate
SourceHeaderCount = ActiveSheet.UsedRange.Columns.Count
Set SourceHeaderRange = Sht.Range("A1:A" & SourceHeaderCount)
ReDim Preserve SourceHeaders(0 To UBound(SourceHeaders) + SourceHeaderCount)
SourceHeaders(UBound(SourceHeaders)) = SourceHeaderRange
Next Sht
Again, the idea is to grab the contents of A:A (used contents only), so that I have a list of what the file does have, then compare that list with what I need it to have, then from there I need to create sub functions to handle each type of conversion. First thing's first though, I need to know what the file has. Any ideas how I can make this work? I recognize that this approach has flaws when confronting non-standardized data (like what if a2 is unused but a3 is used?) but for the purposes of this context, assume all documents are easy to work with and there's no real strange data scheme to worry about.
Thanks for the help!
I find when aggregating a number of worksheets with similar (but non-conforming) layouts to a common worksheet, the brick-by-brick approach takes a little longer but it the most thorough. In the following, each sequenced worksheet has each column heading label examined to see if it already exists in the target worksheet. If not, it is inserted at the right-most end of row 1 and the cycle continues.
Dim r As Long, c As Long, tr As Long, tc As Long, ws As Worksheet, wst As Worksheet
Set wst = Sheets("All_of_Them")
For Each ws In Worksheets
With ws
If .Name <> wst.Name Then
With .Cells(1, 1).CurrentRegion
tr = wst.Cells(1, 1).CurrentRegion.Rows.Count + 1
For c = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
If Not CBool(Application.CountIf(wst.Rows(1), .Cells(1, c).Value)) Then
wst.Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1) = .Cells(1, c).Value
End If
tc = Application.Match(.Cells(1, c).Value, wst.Rows(1), 0)
.Columns(c).Offset(1, 0).Copy Destination:=wst.Cells(tr, tc)
Next c
End With
End If
End With
Next ws
Set wst = Nothing
The above should be easily expanded to multiple workbooks in one or many folders. The target worksheet can start off as a blank worksheet and the aggregated column header labels will be constructed as new header labels are introduced with sequenced worksheets.

How do I export specifc rows of data to another spreadsheet

I'm totally new to VBA and have a requirement to export specific rows based on a value within a specific column to another spreadsheet. Unfortunately I can't post an example so I'll try to explain. I have a sheet that consists of columns A to D and any number of rows. I need to copy all rows that contain [DV] anywhere in column C to another sheet in another spreadsheet.
I have another couple of variants that I would also need to do but I'm hoping if I get this one I can then modify it to suit my needs for the others.
You will have to read, each row under the column C (for each). At each row you will need to sub string the characters in that cell. If they match your condition (DV), than copy it to your desired worksheet.
You didn't provide any code, so this is the best I can help you. If you want more help, you will need to provide some code, and show where it is exactly that you are stuck.
this should do it :
Dim cl As Range
dim wb as workbook
dim ws as worksheet
set wb = workbooks.open("Your other workbook path & name")
set ws = wb.Sheets("destination sheet name")
For Each cl In Range("D1:D" & Range("D1").End(xlDown).Row)
If InStr(cl.Offset(0, -1).Value, "[DV]") > 0 Then
cl.EntireRow.Copy
ws.Range("A50000").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next cl