I can't deal with making "Exit Sub" function work the way I need. The goal of macro I'm working on is to import data from another workbook to temporary sheet, do some basic formatting and then copy these data to first empty row in a target sheet.
To avoid duplicating records in the target sheet i need to compare it with the temporary one and exit sub if there are no new records - the compared criteria are dates ('3). It works properly only when there are fresh data, they are copied to the target worsheet excactly the way I want.
On the other hand when there are no fresh records the macro copies the header from the temporary sheet to the target one (to 1st empty row) instead of exit the sub as intended. I use the following code:
Application.ScreenUpdating = False
Dim Fnm As String ' 1. Import raw data from another workbook to temporary sheet
Dim SrcWb As Workbook
Dim DestWb As Workbook
Set DestWb = ThisWorkbook
Fnm = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fnm = "False" Then Exit Sub
Set SrcWb = Workbooks.Open(Fnm)
SrcWb.Sheets("Arkusz1").Range("A:CJ").Copy DestWb.Sheets("Tmp_Data").Range("A:CJ")
SrcWb.Close False
If Arkusz2 Is ActiveSheet Then ' 2. Necessary formatting of temporary sheet
Call CleanData
Else
Arkusz2.Activate
Call CleanData
End If
Dim Max_date1, Max_date2 As Date ' 3. Compare dates in temporary and target sheet - not working when no fresh records
Max_date1 = Application.WorksheetFunction.Max(Arkusz2.Columns("E:E"))
Max_date2 = Application.WorksheetFunction.Max(Arkusz3.Columns("E:E"))
If Max_date1 <= Max_date2 Then
MsgBox "No new data to copy"
Call DlTmpData
Exit Sub
End If
Call ClFltr ' 4. Filter data in temporary sheet
Call CopyTmpData ' 5. Copy filtered data from temporary to target sheet
If Arkusz3 Is ActiveSheet Then ' 6. Formatting data in target sheet
Call ClFrmt
Else
Arkusz3.Activate
Call ClFrmt
End If
Call DlTmpData ' 7. Remove data from temporary sheet
Related
I am trying to combine a table from multiple workbooks and create a new master workbook which contains all the extracted tables. My current code successfully copies and pastes data from each workbook but still have a few issues and couldn't figure them out by myself.
First, I want to skip the first row, which is just variable names, starting from the second source file. I still need it from the first source file so that my master workbook can have column names in the first row. I tried to achieve this using some loops but it didn't work. Which part do I need to update in order to do this?
Second, is there a way to create an additional column in the master workbook as a flag that shows the source file of data when I copy and paste a table from each individual source file to the master?
For example, if a source excel file is named "file123", the flag column would contain "file123" as its value.
Lastly, in the line of my code where it pastes the copied value,
MaWS.Range("A12785").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
I randomly assigned a big number "A12785" but how do I determine this value? Can I just keep it random?
FYI, here is my current code.
My master workbook is named "Master" and has a sheet named "Summary"
My source files have the table in the "data" tab.
Option Explicit
Sub Merge()
Dim SrPath As String
Dim MaPath As String
Dim SrName As String
Dim MaName As String
Dim SrTemplate As String
Dim MaTemplate As String
Dim SrWS As Worksheet
Dim MaWS As Worksheet
'Define folders and filenames
SrPath = "C:\Users\Documents\Test\"
MaPath = "C:\Users\Documents\Test\Master\"
SrTemplate = "*.xlsx" '
MaTemplate = "Master.xlsm"
'Open the template file and get the Worksheet to put the data into
MaName = Dir(MaPath & MaTemplate)
Workbooks.Open SumPath & SumName
Set MaWS = ActiveWorkbook.Worksheets("Summary")
'Open each source file, copying the data from each into the template file
SrName = Dir(SrPath & SrTemplate) 'Retrieve the first file
Do While SrName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open SrPath & SrName
Set SrWS = ActiveWorkbook.Worksheets("data")
'Copy the data from the source and paste at the end of Summary sheet
SrWS.Range("A1:N35").Copy
sumWS.Range("A12785").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
'Close the current sourcefile and get the next
Workbooks(SrName).Close SaveChanges:=False 'close
MyName = Dir 'Get next file
Loop
'Now all sourcefiles are copied into the Template file. Close and save it
Workbooks(MaName).Close SaveChanges:=True
End Sub
Thank you.
I have never don't VBA scripting, or macros.
However I need to copy pasting a lot of excel documents into one. So I was wondering how I could implement the following (or what direction to head):
I need to copy a table of x rows and y columns but there are many empty rows. And a lot of rows are merged. I need to copy this to another file and unmerge the rows and copy the content to all of the merged columns.
There are multiple files like this and need to go into one file. Each file has varying amount of sheets.
If anything is there anyways I can just created a macro to copy and paste only non empty columns and unmerge the merged columns and have the same data between all the merged rows?
This is a partial answer, which does not address the processing of the individual sheets. It does give you a framework to start with.
Sub Process_Workbooks()
'Process a Collection of workbooks
Dim arrPathandFile, FilePointer As Long
Dim strPathAndFile As String
Dim bkSource As Workbook, shInput As Worksheet
Dim bkDestination As Workbook, shResult As Worksheet
Dim myPath, PathandFile As String
arrPathandFile = Application.GetOpenFilename("Audit Files (*.xls*), *.xlsx, All Files (*.*), *.*", , "Select Workbooks to process", "", True)
' user cancels file selection
If Not IsArray(arrPathandFile) Then Exit Sub
'Create a place to put the results
Set bkDestination = Workbooks.Add
'For each file in the collectin
For FilePointer = 1 To UBound(arrPathandFile)
strPathAndFile = arrPathandFile(FilePointer)
'Open the workbook
Set bkSource = Workbooks.Open(strPathAndFile)
'process each worksheet
For Each shInput In bkSource.Sheets
Set shResult = bkDestination.Sheets.Add
shResult.Name = shInput.Name & "(" & FilePointer & ")"
'figure out the source range to copy
shInput.Range("A1:Z900").Copy Destination:=shResult.Range("A1")
'now do stuff to the sheet in the destination.
Call Do_Stuff_To_sheets(shInput)
'repeat for each sheet in the workbook
Next shInput
bkSource.Close
'repeat for each workbook selected
Next FilePointer
'save the results
bkDestination.SaveAs myPath & "NewFilename.xlsx"
End Sub
Private Sub Do_Stuff_To_sheets(mySheet As Worksheet)
'process each sheet to unmerge and defrag columns
End Sub
I am looking for a macro to paste some data onto a moving range. I already have a cell that tells me the number of the next non empty column and this is the code I currently use:
Dim OpenFileName As String
Dim wb As Workbook
'Select and Open workbook
OpenFileName = Application.GetOpenFilename()
If OpenFileName = "False" Then Exit Sub
Set wb = Workbooks.Open(OpenFileName)
'Get data EXAMPLE
ThisWorkbook.Sheets("Teleselling 17").Range("I9:I289")*this should be dynamic, I want to paste data in a moving range*.Value = wb.Sheets("TELESELLING INBOUND").Range("L9:L289").Value
wb.Close SaveChanges:=False
MsgBox ("Done!")
Use the newly opened workbook/worksheet/range to define the scope of the value transfer.
with wb.workSheets("TELESELLING INBOUND").Range("L9:L289")
ThisWorkbook.workSheets("Teleselling 17").Range("XFD9").end(xltoleft).offset(0, 1).resize(.rows.count, .columns.count) = .value
end with
I have a simple macro that opens a csv file and supposed to copy a cell in the working Workbook:
Sub macro1()
Dim build_w As Workbook
Dim build_s As Worksheet
Dim folder_st As String
Application.ScreenUpdating = False
folder_st = "c:\file.csv"
Set build_w = Application.Workbooks.Open(folder_st)
Set build_s = build_w.Sheets("build")
build_s.Range("A1").Copy
ActiveSheet.Paste Range("A284")
build_w.Close True
Application.ScreenUpdating = True
End Sub
If I comment out the line build_s.Range("A1").Copy everything is fine, but If I leave this in, Excel crashes every single time.
Any suggestions?
Are you aware that the ActiveSheet at the moment you paste is itself the build_s worksheet? This is the problem when working with stuff like Activesheet. It is always preferable to specify worksheet and workbook objects precisely, without counting on what is active at a given moment.
Eventually, to get the behavior you want, you should do:
build_s.Range("A1").Copy ThisWorkbook.ActiveSheet.Range("A284")
Have you tried handling any possible errors with:
On Error GoTo MyHandler
MyHandler:
PFB for the require code. CSV file cannot have multiple sheets so that's why it must be crashing. CSV files can have only one sheet in it, so no need to specify sheet name.
Sub macro1()
'Declared variables
Dim build_w As Workbook
Dim folder_st As String
'Disabling screen updates
Application.ScreenUpdating = False
'Initializing the file name
folder_st = "c:\file.csv"
'Opening the workbook
Set build_w = Workbooks.Open(folder_st)
'Copying the value of cell A1
Range("A1").Copy
'Selecting the cell A284
Range("A284").Select
'Pasting the copied value
ActiveSheet.Paste
'Saving the workbook by saving the .CSV file
build_w.Close True
'Enabling screen updates
Application.ScreenUpdating = True
End Sub
it's because upon opening csv file it becomes the Active workbook and its only worksheet the Active worksheet
you can exploit this at your advantage like follows:
Option Explicit
Sub macro1()
Dim folder_st As String
Application.ScreenUpdating = False
folder_st = "c:\file.csv"
With ActiveSheet '<--| reference your currently active sheet before opening csv file
Application.Workbooks.Open(folder_st).Sheets("build").Range("A1").Copy '<--| open csv file (and it becomes the Active Workbook) and reference its "build" sheet range "A1" and copy it...
.Range("A284").PasteSpecial '<--| paste it to your referenced sheet range A284
Application.CutCopyMode = False '<--| release clipboard
ActiveWorkbook.Close False '<--| close Active workbook, i.e. the csv file
End With
Application.ScreenUpdating = True
End Sub
I have an vba macro that should (after updating some values from an online xml) save one sheet to a CSV file. This works, but if I open the CSV file, I see this:
CHF,Swiss Franc,1.2352,,,
CNY,Yuan Renminbi,8.1803,,,
EUR,Euro,1,,,
GBP,Pound Sterling,0.8585,,,
HKD,Hong Kong Dollar,10.3617,,,
SGD,Singapore Dollar,1.7097,,,
USD,US Dollar,1.3361,,,
,,,,,
,,,,,
So the problem is that three empty colomns and two empty rows are also saved. I know this raises no problems after opening the CSV file in Excel, but in the program I import it, it does.
I did some research and found that this probably has to do with the UsedRange. But i could find no way to set the usedRange to a new value, or only save a small part of the sheet.
I probably can copy the range I want, open a new workbook, paste this range and save this to a file, but this seems a bit harder than it should be. And it does not guarantee that my UsedRange in this new workbook is not also to big.
Does anyone know how to set the usedrange or do the things I want another way? I am an absolute VBA amateur, so if I did strange things, thats the reason.
The rest of my code works fine, so the problem is only in the extra comma's in the saved file.
My VBA code is below:
Sub updateCurrencies()
'
' updateCurrencies Macro
'
' Keyboard Shortcut: Ctrl+e
'
Application.DisplayAlerts = False
Dim wb As Workbook
Dim ws As Worksheet
Dim file As String
file = "\\SBS2008\RedirectedFolders\jasper\Desktop\currencies.csv"
Sheets("Sheet1").Select
ActiveWorkbook.XmlMaps("Envelope_Map").DataBinding.Refresh
Set ws = Sheets("currencies")
ws.Select
ActiveWorkbook.RefreshAll
ws.SaveAs file, FileFormat:=6
Sheets("info").Select
Set wb = Workbooks.Open(file)
wb.Save
Sheets("info").Select
Call CloseAllWorkbooks
End Sub
Public Sub CloseAllWorkbooks()
Dim wb As Workbook
For Each wb In Workbooks
If (wb.Name = "currencies") Then
wb.Close True
Else
wb.Close False ' Or True if you want changes saved
End If
Next wb
End Sub
See the answer here by Daniel Cook
Convert xls File to csv, but extra rows added?
Sub CorrectUsedRange()
Dim values
Dim usedRangeAddress As String
Dim r As Range
'Get UsedRange Address prior to deleting Range
usedRangeAddress = ActiveSheet.UsedRange.Address
'Store values of cells to array.
values = ActiveSheet.UsedRange
'Delete all cells in the sheet
ActiveSheet.Cells.Delete
'Restore values to their initial locations
Range(usedRangeAddress) = values
End Sub