Issue copying number from one xlsm to another via VBA - excel

I'm attempting to reset some cells in an xlsm and then copy a single cell from one workbook to another via a VBA macro. Code is below:
Range("E19").Copy
Range("E6").PasteSpecial xlPasteValues
Range("E5").Value = 0
Range("E8:E9").Value = 0
Range("E11:E12").Value = 0
Range("E25:E28").Value = 0
Range("E30").Value = 0
Range("I25:I31").Value = 0
Range("G2").Clear
Dim ubbPrevDay As Single
Dim objWorkbook As Workbook
'open the workbook with data
Set objWorkbook = Workbooks.Open("<file path censored for privacy>")
ubbPrevDay = objWorkbook.Worksheets("UBB").Range("C13")
'close the workbook
objWorkbook.Close SaveChanges:=False
Range("E4") = ubbPrevDay
Dim name As String
name = InputBox("Enter your name")
Range("G2").Value = name
The operation runs and copies a value, but occasionally copies the decimal just a little bit incorrectly. Today it copied '550687.88' as '550687.875'. I verified that the data on the workbook being copied is correct so something is getting altered in the macro process. Any advice is greatly appreciated.
-Kevin

Related

Copy non adjacent data cells into one workbook

this is the code that i am currently using right now, but its not enough to meet my objectives and i am stuck on how to continue....
So this code will copy the specified data from many other excel workbook in the form of xlsx into a main excel workbook and before that it will scan through the folder which contains all the different data files and the main file(all files supposed to be transfered here in a table form) e.g. Test3.xlsx,Test4.xlsx,Test.xlxs and Main.xlsm in the folder of ScanFiles. so everytime a new files comes into the folder, it will automatically update the main workbook by opening the data workbooks then copy the required data and paste it on the main workbook upon clicking a button.
Sub ScanFiles()
Dim myFile As String, path As String
Dim erow As Long, col As Long
path = "c:\Scanfiles\"
myFile = Dir(path & "*.xlsx")
Application.ScreenUpdating = False
Do While myFile <> ""
Workbooks.Open (path & myFile)
Windows(myFile).Activate
Set copyrange = Sheets("sheet1").Range("A18,B18,C18,D18,A19,B19,C19,D19")
Windows("master-wbk.xlsm").Activate
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
col = 1
For Each cel In copyrange
cel.Copy
Cells(erow, col).PasteSpecial xlPasteValues
col = col + 1
Next
Windows(myFile).Close savechanges:=False
myFile = Dir()
Loop
Range("A:E").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Objectives: 1st:orignal type of file is in "file" not xlsx, so hope to find a way to open the file in xlsx format automatically before start of copying data.
2nd: requires 3 types of specified data e.g. name,surname(both of them are in fixed position always in A18 to D18 and A19 to D19 , 3rd one is to find the date, however the date is almost always in different positions in the data sheet, so i hope to add on a part to the code that makes it search for something like "ended 20190808" it will always start with ended but will always be in diff rows or even columns. i also need to arrange the data according to the date from newest(top) to oldest(bottom) and state the month of the date in words instead of numbers e.g. june
Deeply Appreciate any form of help but if possible the small section of code that can add on to my coding will make it a lot easier because im tasked to do this in a very limited amount of time
Thank you!!!
Here's some code that does similar things to what you describe. The animated .gif shows it working by stepping through the code. First the 2 data (.xlsx) files are shown so you have an idea of their content. Each is located in the same folder as the main workbook and has data in column A. Then as we step through the code each file is opened, its data manipulated (row 3 is deleted) and transferred into adjacent columns of the main workbook. The code is not limited to .xlsx files and will work with text files as well, as long as ext is defined.
Hopefully, once you understand how this works you can modify it to apply it to your case.
Option Explicit
Sub CombineFiles()
Dim theDir As String, numFiles As Integer
Dim sh As Worksheet, wk As Workbook, newSheet As Worksheet
Dim newColumn As Range, r As Range, s As String
Const ext = ".xlsx"
Err.Clear
theDir = ThisWorkbook.Path
Set newSheet = ThisWorkbook.Sheets.Add
newSheet.Name = "Combined"
Set newColumn = newSheet.Range("A1")
'Loop through all files in directory
s = Dir(theDir & "\*" & ext)
While s <> ""
numFiles = numFiles + 1
On Error Resume Next
Set wk = Workbooks.Open(theDir & "\" & s)
Set sh = ActiveSheet
sh.Rows(3).Delete Shift:=xlUp
Set r = Range("A1")
Range(r, r.End(xlDown)).Copy
newSheet.Activate
newColumn.Offset(0, numFiles) = wk.Name
newColumn.Offset(1, numFiles).Select
newSheet.Paste
Application.DisplayAlerts = False
wk.Close False
Application.DisplayAlerts = True
s = Dir()
Wend
MsgBox (numFiles & " files were processed.")
End Sub
For copy/paste of pictures see examples on this or this page. To find the last cell containing data in a column see this page; note that one example involves using the .find command. More generally, to learn how to use .find in vba, use the macro recorder and then adjust the resulting code.

create multiple workbooks in certain folder location

Lets say I want to create 5 workbooks in certain location. I was trying to use this code but it doesn't work. (run-time error, automation error), what is wrong with it?
Sub blabal()
Dim wbk As Workbook
Dim i As Integer
i = 1
Set wbk = Workbook.Add
Do Until i = 5
wbk.SaveAs "C:\Users\User1\Desktop\abc\" & i
wbk.Close
i = i + 1
Loop
End Sub
Set wbk = Workbooks.Add
You need to specify Workbooks instead of Workbook.
Workbooks is a collection object. You're adding a Workbook to the collection of Workbooks.
You also need to change the order of your code, so you're either not closing the workbook each time, or so that you are closing the workbook, but you're then adding a new workbook (which doesn't really make much sense, but I'll show an example anyway).
Set wbk = Workbooks.Add
Do Until i = 5
wbk.SaveAs "C:\Users\User1\Desktop\abc\" & i
i = i + 1
Loop
Or
Do Until i = 5
Set wbk = Workbooks.Add
wbk.SaveAs "F:\" & i
wbk.Close
i = i + 1
Loop

Error when using Workbooks

I would like to develop a method to ensure that information is copied from 1 workbook (ThisWorkbook) and is pasted in another workbook (All data.xlsm) on empty rows. I was able to develop the code if the 2 sheets are in the same workbook, but now that I need to refer to another workbook it doesn't work (error 9). The difficulty is also that both workbooks are on a teamsite, but both files are open.
Please find below my code (with my best attempt).
Dim actionlogRow
Dim actionlogRowSet As Boolean
Dim RecordSave As String
Dim recordActionLog As String
actionlogRow = 1
actionlogRowSet = False
Application.ScreenUpdating = False
RecordSave = Range("new_actions").Cells(1, 1).Value
Workbooks("All data.xlsm").Activate
Do
recordActionLog = Worksheets("Action Log").Range("C8:AE8").Offset(actionlogRow, 0).Cells(1, 1)
If recordActionLog = "" Then
'Location to copy to is current row
actionlogRowSet = True
Else
'Look at next row
actionlogRow = actionlogRow + 1
End If
Loop Until actionlogRowSet = True
'Copy the record into the database
Call ThisWorkbook.Sheets("New actions").Range("new_actions_endorsed").Copy
Call Workbooks("All data.xlsm").Worksheets("Action Log").Range("C8:AE8").Offset(actionlogRow, 0).PasteSpecial(xlPasteValuesAndNumberFormats)
Application.ScreenUpdating = True
You must have both spreadsheets open in the same instance of Excel. If you open Excel first, then open both spreadsheets from that (Ctrl O) you should be fine. However if you open two Excel program files, they cannot see each other and you will get "Run-time error 9: Subscript out of range"

Outlook Excel Compare data from two closed workbooks

I am new to Outlook VBA and am trying to compare the value in the same cell from two different closed workbooks.
I have created an Excel Object upon receiving an attachment from an email that saves the attachment as a CSV file.
I then want to check that the header row within the file matches a master copy which has the same headers in the first row but I am not sure how to reference the sheet names nor the cells using the objects.
I have tried many ways using VBA for Excel but it doesn't seem to work in Outlook.
If any one can assist me it would be greatly appreciated.
Function ConvertXls2CSV(sXlsFile As String)
On Error Resume Next
Dim oExcel As Object
Dim oExcelWrkBk As Object
Dim bExcelOpened As Boolean 'Was Excel already open or not
Dim OriginalFile As String
Dim MasterFile As String
Dim Fault As Integer
Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oExcel = CreateObject("excel.application")
bExcelOpened = False
Else 'Excel was already running
bExcelOpened = True
End If
Set oExcelWrkBk = oExcel.Workbooks.Open(sXlsFile)
oExcelWrkBk.SaveAs Left(sXlsFile, InStrRev(sXlsFile, ".")) & "csv", xlCSVWindows
/*THIS IS WHERE I WANT TO REFERENCE THE CELLS IN THE WORKBOOKS*/
OriginalFile = oExcelWrkBk.Sheets("PK Price Data").Cells(1, 1).Value
MasterFile = oExcelWrkBk."MasterFile.xls".Sheets("PK Price Data").Cells(1, 1).Value
if OriginalFile = MasterFile then
fault = 1
else fault = 0
end if
oExcelWrkBk.Close False
If bExcelOpened = False Then
oExcel.Quit
End If
End Function
Many Thanks
Melinda
As far as I know, it's not possible to address your references to a closed workbook. You can, however, open it without showing with application.screenupdating = false. When you're done storing your references in some variables, you can simply close the workbooks and set application.screenupdating = true

VB Script to copy all sheet data one excel to another excel sheet

Is it possible to copy data from all the workbook sheets from one excel sheet (ex: A.xls) to another existing excel (ex: B.xls).
Can a logic be implemented, using VB, where it can do that no matter the amount of workbook sheets in A.xls (i.e. It should copy all the data of all pages of A.xls to B.xls)
I appreciate any kind of help, for I am not from a programming background.
Though I'm starting to think you want to copy all the data across many tabs to one tab, if you actually want to keep the data on separate tabs, you can use something like this to loop through the worksheets in A.xlsx and copy them to B.xlsx:
Sub copy_sheets()
Dim eapp As Excel.Application
Dim wkbk_from As Workbook
Dim wkbk_to As Workbook
Dim wksh As Worksheet
Set eapp = CreateObject("Excel.Application")
Set wkbk_from = eapp.Workbooks.Open("C:\Documents\Miscellaneous-DT\Excel\a.xlsx")
Set wkbk_to = eapp.Workbooks.Open("C:\Documents\Miscellaneous-DT\Excel\b.xlsx")
eapp.Visible = True
For Each wksh In wkbk_from.Worksheets
wksh.Copy After:=wkbk_to.Worksheets(Worksheets.Count)
Next wksh
End Sub
Well After a lot of struggle and learning some basics i was able to get the code
Here is the code which works
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objPasteData = objExcel.Workbooks.Open("C:\A.xlsx") 'Copy From File
Set objRawData= objExcel.Workbooks.Open("C:\B.xls") 'Paste To File
Set obj1 = objPasteData.WorkSheets("RawData") 'Worksheet to be cleared
obj1.Cells.Clear
countSheet = objRawData.Sheets.Count
For i = 1 to countSheet
objRawData.Activate
name = objRawData.Sheets(i).Name
objRawData.WorkSheets(name).Select
objRawData.Worksheets(name).Range("A2").Select
objExcel.ActiveSheet.UsedRange.Select
usedRowCount1 = objExcel.Selection.Rows.Count
objExcel.Range("A2:H" & usedRowCount1).Copy
objPasteData.Activate
objPasteData.WorkSheets("RawData").Select
objExcel.ActiveSheet.UsedRange.Select
usedRowCount2= objExcel.Selection.Rows.Count
objPasteData.Worksheets("RawData").Range("A"& usedRowCount2 + 1 ).PasteSpecial Paste =xlValues
Next
objPasteData.Save
Thanks #Nilpo & #rryanp for guidance.
The easiest way to copy all data from one worksheet to another is to use the copy and paste operation on a range that consists of all filled cells.
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook1= objExcel.Workbooks.Open("C:\test1.xls")
Set objWorkbook2= objExcel.Workbooks.Open("C:\test2.xls")
Set objRange = objWorkbook1.Worksheets("Sheet1").UsedRange.Copy
objWorkbook2.Worksheets("Sheet1").Range("A1").PasteSpecial objRange
objWorkbook1.Save
objWorkbook1.Close
objWorkbook2.Save
objWorkbook2.Close
You say existing file b.xls, wbut if you overwrite everything, it doesn't matter so why not use
CreateObject("Scripting.FileSystemObject").CopyFile "a.xls", "b.xls", true
I had the same task yesterday and had to spent a lot of time searching for the parts of the solution. From some reason in vbs named constants are not available (at least in newer Excel versions).
The script below is tested and prooved to be working in newer Excel (2016)
outputFiletype = 51 'type_xlsx
' I assume you want to use the script for different files, so you can pass the name as a parameter
If Wscript.Arguments.Count < 1 Then
Wscript.Echo "Please specify a name of the Excel spreadsheet to process"
Else
inputFilename = Wscript.Arguments(0)
outputFilename = Replace(inputFilename, ".xlsx", "_calc.xlsx")
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False
' if you want to make the excel visible (otherwise if it is failed it will hang in a process list)
'objExcel.Application.Visible = True
Set currentWorkbook = objExcel.Workbooks.Open(inputFilename)
Set newWorkbook = objExcel.Workbooks.Add()
i = 0
For Each current_sheet In currentWorkbook.Worksheets
If current_sheet.Visible Then ' copying only the visible ones
i = i + 1
Dim new_sheet
If newWorkbook.Sheets.Count < i Then
newWorkbook.Sheets.Add , newWorkbook.Sheets(i-1) ' after the last one
End If
Set new_sheet = newWorkbook.Sheets(i)
new_sheet.Name = current_sheet.Name
current_sheet.UsedRange.Copy
new_sheet.Select
new_sheet.UsedRange.PasteSpecial 13 'xlPasteAllUsingSourceTheme - Everything will be pasted using the source theme
new_sheet.UsedRange.PasteSpecial 8 'xlPasteColumnWidths - Copied column width is pasted
new_sheet.UsedRange.PasteSpecial 12 'xlPasteValuesAndNumberFormats - Values and Number formats are pasted.
End If
Next
newWorkbook.SaveAs outputFilename, outputFiletype
currentWorkbook.Close False
newWorkbook.Close False
objExcel.Quit
End If

Resources