I have a program utilizing openpyxl that opens two existing Excel files. One is a simple worksheet with data that needs to be copied into the other file, which is a workbook containing many worksheets and with VBA macros that use this copied data. When the VBA code runs, though, I get a Runtime Error 6 overflow. The strange thing is that if I manually copy all of the required cells into the workbook, the macros run without a hitch. But when this process is automated, even though the values in the cells are identical, this error pops up. Below is the code which transcribes the data from one worksheet to the other.
def transcribe_client_data_to_workbooks():
_active_sheet_index = 5
for client in set(cdict.values()):
report_path = r'C:\Program Files\Notepad++\reports' + '\\' +
string.replace(client,'/','-') + '_report.csv'
wb = openpyxl.load_workbook('Bucket-Asset Allocation Model.xlsm',
read_only = False, keep_vba = True)
ws = wb.active
with open(report_path, 'rU') as f:
reader = csv.reader(f)
for row_index, row in enumerate(reader):
for column_index, cell in enumerate(row):
column_letter = get_column_letter((column_index+1))
ws[column_letter+str(row_index+1)] = cell
f.close()
wb.save('C:\\Program Files\\Notepad++\\workbooks\\' +
string.replace(client,'/','-') + '_workbook.xlsm')
I don't understand why I would receive this error message when this data is automatically copied in, but not when I copy/paste manually. I open the same workbook template each iteration and then save it as a new one after the appropriate data has been copied over. For reference, here is the section of VBA code where the error occurs.
Do Until Sheets("Raw Data").Cells(crow, 1).Value = Empty
aNumber = Sheets("Raw Data").Cells(crow, 1).Value
ticker = Sheets("Raw Data").Cells(crow, 9).Value
security = Sheets("Raw Data").Cells(crow, 8).Value
mValue = Sheets("Raw Data").Cells(crow, 12).Value
bAmt = Sheets("Raw Data").Cells(crow, 18).Value
uGain = Sheets("Raw Data").Cells(crow, 20).Value
Do Until Sheets("Accounts").Cells(acrow, 1).Value = aNumber
acrow = acrow + 1
Loop
Specifically it occurs on the line that increments acrow:
acrow = acrow + 1
I tried changing acrow from an integer to a long, but that just causes the program to run indefinitely until I click or cancel it, at which point I receive Run-time error '1004', Application defined or object-defined error, on the line directly preceding the increment of acrow.
Any help would be appreciated, thanks!
John Coleman was correct about the location of the overflow. The issue was that I was writing aNumber as strings and aNumber was declared in the VBA as Variant type, which according to the docs can represent anything other than a fixed length string. I simply changed my strategy and wrote account numbers as integers which resolved the problem.
Related
I am working on a code that copies certain cell values from a workbook to another workbook. The twist is that the information is in hexadecimal in one workbook and I need to convert the value in decimal when I copy it to the other workbook.
What is weird is that everything works perfectly and the code copies and then adds the value, converted in the workbook needed; all until it reaches the last row and that's where I get the error. (the error shows up at the line that has a comment added)
Debug.Print Now
varSheetA = varSheetA.Range(RangeA)
Debug.Print Now
i = 1
For rowN = LBound(varSheetA, 1) To UBound(varSheetA, 1)
Tst = Mid(wbkB.Worksheets("CopyFromHere").Cells(rowN + 1, 2).Value, 3, 6)
Set Rng = wbkA.Worksheets("Sheet1").Range(RangeA).Find(Tst)
If Rng Is Nothing Then
i = i + 1
wbkA.Worksheets("Sheet2").Cells(i, 5).Value = WorksheetFunction.Hex2Dec(wbkB.Worksheets("CopyFromHere").Cells(rowN + 1, 5).Value) 'error is here
End If
Next
I need to mention that some of the values that are in hexadecimal are these (just to have an idea): 239, 7E101, 7FA3A, B38
And the value that currently the program gives error is B38
I don't understand why this happens, as the code runs perfectly well until that value/last row. I don't know which one is the problem.
Clean the "cell" before like that
wbkA.Worksheets("Sheet2").Cells(i, 5).Value = _
WorksheetFunction.Hex2Dec(Trim(wbkB.Worksheets("CopyFromHere").Cells(rowN + 1, 5).Value))
I'm writing a macro that will populate an excel file with user inputs from active x controls in word. I've got almost everything working except that I keep getting an error message when I try and select cell A1 in the sheet that I want to use in the workbook. Here is the code:
Workbooks.Open ("mypath\myfile.xlsm")
Workbooks("myfile.xlsm").Activate
Worksheets("sheet1").Select
Range("A1").Select
Do Until (IsEmpty(ActiveCell.Value))
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = n
ActiveCell.Offset(0, 1).Value = a
ActiveCell.Offset(0, 2).Value = b
ActiveCell.Offset(0, 3).Value = c
Columns("D:D").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Workbooks("myfile.xlsm").Save
Workbooks("myfile.xlsm").Close
The variables in this block of code are the values of the active x controls and are located much further up in the sub. This block of code is a small part of an if statement within the sub. Anyhow, when I take Range("A2").Select out of the code, it works just fine except for the fact that the information that I want to input does not go to the right spot (since it didn't select range A1 to begin with).
The error I get is type mismatch 4218.
Referencing the Excel object model gives you access to some global objects defined in that object model.
VBA resolves identifiers in this order:
Current procedure
Current module
Current project
VBA standard library
Host application object model
Any other referenced library, in the order they appear in the references dialog
So when you invoke Range meaning to be a call to the Excel object model, you actually invoke the same-name Range global member that's defined in the Word object model.
Note I say member and mean it: these are unqualified member calls to Global.Range. This is important, because a member implies an object, and since everything in the Excel object model (Word's too) has an Application property, then if you're not explicit about exactly what you're referring to, you might be implicitly creating an Excel.Application object, that you can't quite clean up properly. This usually translates into a "ghost" EXCEL.EXE process lingering in Task Manager well after your macro finishes running.
The trick is to make that reference explicit, and explicitly constrain its lifetime - a With block is perfect for this:
With New Excel.Application
With .Workbooks.Open(path)
With .Worksheets("Sheet1")
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lRow, 1) = n
.Cells(lRow, 2) = a
.Cells(lRow, 3) = b
.Cells(lRow, 4) = c
.Columns("A:D").EntireColumn.AutoFit
End With
.Save
.Close
End With
.Close
End With
I'm guessing as I don't usually run Excel from Word, but I think the problem might be related to everything being unqualified from Word.
If Workbooks.Open is working, then we can just hang everything related to that workbook on that..
Try the following code instead:
Dim myWkBk As Workbook, lRow As Long
Set myWkBk = Excel.Application.Workbooks.Open("mypath\myfile.xlsm")
With myWkBk.Sheets("sheet1")
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lRow, 1) = n
.Cells(lRow, 2) = a
.Cells(lRow, 3) = b
.Cells(lRow, 4) = c
.Columns("A:D").EntireColumn.AutoFit
End With
myWkBk.Save
myWkBk.Close
I've got it figured out. #Cindy Meister I just needed to add an ActiveSheet. qualifier on the troubled line:
Workbooks.Open ("H:\Second Rotation\OBI project\answersUsers.xlsm")
Workbooks("answersUsers.xlsm").Activate
Sheets("Answers Users").Select
ActiveSheet.Range("A1").Select
Do Until (IsEmpty(ActiveCell.Value))
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = n
ActiveCell.Offset(0, 1).Value = cwid
ActiveCell.Offset(0, 2).Value = mann
ActiveCell.Offset(0, 3).Value = dept
Columns("A:D").EntireColumn.AutoFit
Workbooks("answersUsers.xlsm").Save
Workbooks("answersUsers.xlsm").Close
Dim myWkBk As Workbook, lRow As Long
Here is all the applicable code that I'm having a hard time with (though part of a large program). I'm making an executive dashboard, and this data rolls up into a chart on a separate sheet looking at month-over-month utility usage. It is supposed to copy over a variable number of utilities from a variable number of months.
Integer m is the months (I'm using 3/March as my example), so from i=1 to 3 it's supposed to copy/paste the rows from the ns that is opened into ws. It keeps giving an error 1004, so I think I'm calling my ranges incorrectly, but I'm not sure how/why. In my code, the error is down in that For Loop, none of the lines seem to work
I need some sort of variable so that I can later roll it up into my chart. Here are some photos of what's supposed to come over (only the headers are coming over, which wasn't using the .Cell(). Also, if anyone knows the correct way to code my second to last line, please share (though not my primary challenge).
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select Trend Income Statement for " & os.Range("B2") & " " & os.Range("B3"))
If fNameAndPath = False Then Exit Sub
'We are opening and pulling data from the selected workbook, so lets turn off screen updating and get to work
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set nb = Workbooks.Open(fNameAndPath)
Set ns = nb.Sheets(1)
m = Month(ws.Range("B1"))
'Build out the Utility Section
Let FindIt = "50100-000"
Set FoundCell = ns.Range("A:A").Find(What:=FindIt)
fRow = FoundCell.Row + 1 'This will be the first Util GL
Let FindIt2 = "50199-999"
Set FoundCell2 = ns.Range("A:A").Find(What:=FindIt2)
fRow2 = FoundCell2.Row - 1 ' This will be the last Util GL
ns.Range("B" & fRow - 1 & ":B" & fRow2 + 1).Copy 'Copy the header range
ws.Range("G16").PasteSpecial Paste:=xlPasteValues
For i = 1 To m
Set cRange = ns.Range(ns.Cells(fRow, 2 + i), ns.Cells(fRow2, 2 + i))
ns.Range(cRange).Copy
Set pRange = ws.Range(ws.Cells(17, 7 + i))
ws.Range(pRange).PasteSpecial Paste:=xlPasteValues
ws.Range(Cells(15, 7 + i)).Formula = "=TEXT(i*30, mmmmm)"
Next i
I had trouble getting several parts of your code to work as it seems to be a snippet of a larger program.
I think what might be causing your issue is that you are using one Cells() in some of your Range() calls. The Range() call returns a 1004 error when I tried providing it with only one Cells() object.
For example you use
'This throws 1004 error
ws.Range(ws.Cells(17 , 7 + i ))
Try to use something like this
ws.Cells(17 , 7 + i)
Also, you can use something like this
ws.Range("G17").Offset(0,i)
See if any of these works for your use case and produces the desired result.
Chopped down from uber-detail history mode per suggestion.
My level of expertise: Hacked some fairly complex dialog-boxing multi-workbook macro systems ten years ago, experienced but not formally trained and rusty.
The complicated stuff in this macro works; its central bug is that it won't change that CurrentClientAnchor Range variable, the most basic operation in Excel VBA, no matter what I do. It loops as many times as you like anchored on cell A2, correctly finding the cell that should next become CurrentClientAnchor (on the real data, A4, two cells down), and creating the invoice sheet perfectly from the selected data as long as you give it permission to overwrite the copy it just created a second ago. I won't be surprised if my special last record routine breaks something, but manually stepping through, none of that If clause ever runs. The program correctly steps over it. WhatsMyAnchor should be 4 just before the last Loop command, but never changes from 2.
The only method I know for accomplishing what I want that doesn't have a commented fossil left in the code is the first one I wrote, assigning a ClientsRange as Range over Range("A2", Cells(LastRow,1)) and then putting everything in a For...Next loop. That version also just ran over and over on the first record.
In what way am I being incredibly stupid, please?
Option Explicit
Sub FillOutInvoices()
Dim BilledDate As String
Dim ServiceYear As String
Dim ServiceMonth As String
Dim CompBasePath As String
Dim InvoiceTemplatePath As String
InvoiceTemplatePath = "H:\Comp\Comp Invoice BLANK PRINT COPY.xls"
'The info to change for each invoicing
'========================
'========================
CompBasePath = "H:\Comp\2014 Invoices\"
ServiceYear = "2014"
ServiceMonth = "September"
BilledDate = "02/01/2015"
'========================
'========================
Dim InvoiceFolder As String
InvoiceFolder = CompBasePath & ServiceYear & " " & ServiceMonth & " generated invoices" & "\"
If Dir(InvoiceFolder, vbDirectory) = vbNullString Then
MkDir InvoiceFolder
End If
'Find the last used row on the sheet with a web recipe to speed things up
'and avoid arbitrary search windows.
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
'We assume our first client is in A2
Dim CurrentClientAnchor As Range
Set CurrentClientAnchor = Range("A2")
Dim DataHeight As Single
Dim NoMoreRecords As Boolean
NoMoreRecords = False
'Debugging variable so I don't have to paw through
'a zillion properties of CCA in the Watch pane all the time
Dim WhatsMyAnchor As Single
WhatsMyAnchor = CurrentClientAnchor.Row
Do Until NoMoreRecords = True 'Loop captures falling through the last record, internal exit catches
'the next result each time
'Surprisingly the main loop. For each client, find the next one or end of job,
'use that as an upper and lower bound to create and write the invoice
'Transplanted inline from what should be a sub, because I need it to Just Work Now.
'As a sub, causes Object Required error on passing the range which is a range into the range slot that's designated as a range.
'This should become some clever run-once array of nonempty ranges someday
'Find next nonempty A. If none before lastrow, last record; find last nonempty F, set rows, copy data, terminate macro.
'If found, set rows and copy data
DataHeight = 1
Do Until CurrentClientAnchor.Offset(DataHeight, 0).Value <> ""
'Find the next nonempty cell below CurrentClientAnchor and record the offset
'We're falling off the bottom of the last one, have to do our special last search up front here.
If CurrentClientAnchor.Offset(DataHeight, 0).Row = LastRow Then 'special finder for last record down F to first empty cell
NoMoreRecords = True
DataHeight = 1
Do Until CurrentClientAnchor.Offset(DataHeight, 5).Value = ""
DataHeight = DataHeight + 1
Loop
Exit Do
End If
DataHeight = DataHeight + 1
Loop
'We now have our DataHeight value for the grunt work.
'Subtract one from it, to convert to the cell offsets we'll use
DataHeight = DataHeight - 1
'Inlined from sub again because I apparently don't know how to pass a variable.
'MakeInvoiceFile
Dim SourceBook As Workbook
Set SourceBook = ThisWorkbook
Dim InvoiceFileName As String
InvoiceFileName = InvoiceFolder & _
CurrentClientAnchor.Value & " " & ServiceYear & " " & ServiceMonth & " Invoice" & ".xls"
Dim DestBook As Workbook
Dim Template As Workbook
Application.Workbooks.Open InvoiceTemplatePath
Set Template = ActiveWorkbook
Set DestBook = ActiveWorkbook
DestBook.SaveAs (InvoiceFileName)
SourceBook.Activate
'Close for debugging cleanliness, more elegant keep open behavior later
'Doesn't work. Maybe not even ugly, anyway cut for dev time.
'Template.Close
'More debugging watchable variables
Dim WhereCopyingRow As Single
Dim WhereCopyingColumn As Single
Dim CopyRange As Range
'Client name into job name
Set CopyRange = CurrentClientAnchor
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(3, 4).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Service address into job location
Set CopyRange = CurrentClientAnchor.Offset(0, 3)
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(4, 4).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Billing address into billing address
Set CopyRange = CurrentClientAnchor.Offset(0, 4)
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(9, 2).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Billing Date into Date Billed
'Currently discarded for progress
'DestBook.Sheets(1).Cells(24, 3).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Descriptions
Set CopyRange = Range(CurrentClientAnchor.Offset(0, 5), CurrentClientAnchor.Offset(DataHeight, 5))
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(13, 2).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Totals
Set CopyRange = Range(CurrentClientAnchor.Offset(0, 14), CurrentClientAnchor.Offset(DataHeight, 15))
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(13, 6).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Overall total
Set CopyRange = CurrentClientAnchor.Offset(DataHeight, 16)
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(24, 6).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
DestBook.Save
DestBook.Close
'SourceBook appears to be activated when we close DestBook, but it's failing to iterate so let's make sure.
SourceBook.Activate
'CurrentClientAnchor = CurrentClientAnchor.Offset(DataHeight + 1, 0)
'WhatsMyAnchor = CurrentClientAnchor.Row
'Apparently we can't assign a range to its offset, fails to iterate, so
'we pop out to selection and back to the variable.
'CurrentClientAnchor.Offset(DataHeight + 1, 0).Select
'CurrentClientAnchor = Selection
'WhatsMyAnchor = CurrentClientAnchor.Row
'Nope. Escalate to activating and assigning.
'CurrentClientAnchor.Offset(DataHeight + 1, 0).Activate
'CurrentClientAnchor = ActiveCell
'WhatsMyAnchor = CurrentClientAnchor.Row
'That doesn't iterate either, it's really hard for a programming language in
'Excel to iterate on the most common object in Excel,
'so let's turn the blasted stupid debugging variable into an absolute cell selector
Set CurrentClientAnchor = ActiveSheet.Cells(WhatsMyAnchor + DataHeight + 1, 0)
WhatsMyAnchor = CurrentClientAnchor.Row
'That throws a 1004 error with or without the Set, "application or object-defined error", thanks.
'It's just impossible to move a Range down a few cells. Excel VBA can't do that. You can't vary a Range variable.
Loop
MsgBox "All successfully written"
End Sub
That is a lot of writing for a relatively small question, I would recommend cutting out any non-essential text in future questions; a lot of people will just see the sheer volume of text and move on.
With respect to your issue I think a minor change would do the job:
The examples you have commented out should work if you just add Set in front of them:
Set CurrentClientAnchor = CurrentClientAnchor.Offset(DataHeight + 1, 0)
As you have it with the line
Set CurrentClientAnchor = ActiveSheet.Cells(WhatsMyAnchor + DataHeight + 1, 0)
Changed to
Set CurrentClientAnchor = ActiveSheet.Range("A" & WhatsMyAnchor + DataHeight + 1)
Should also work.
I am trying to copy data from one Excel workbook to another.
We had a change in the template of an import file, and it has thus ruined the old import files. So there are some files that still need to be imported, but they are under the old template.
My issue stems from when I try to copy the data (paste special, values, anything tried) it gives me an error sometimes: "The Cell or chart that you are trying to change is protected and therefore read-only".
However, that isn't exactly the case. I've determined that it gives that error when I paste a blank cell onto a new field that has a drop-down with Yes or No. Yet, if I manually go to that cell and give it something blank (hit backspace + enter), it has no problems.
I've tried coding so it copy/paste's each line at a time from workbook to workbook, but my problem still remains for these cells that require a drop-down answer. I'm thinking that these cells need to be coded to actually be "typed" instead of pasted. It can't be a part of pasting the actual range.
Does anyone have an idea of how best to resolve this? Below is my current code, it is copying based on the range(s). It's very sloppy as the only way I can think is to keep switching from workbook to workbook. Any help is greatly appreciated.
Also, I'm not 100% on how to calculate the LastRow? So I just have it entered manually.
Sub MoveText()
For Row = 5 To 962
Workbooks("Data.xls").Activate
ActiveSheet.Range(Cells(Row, 1), Cells(Row, 3)).Select
Selection.Copy
Workbooks("blankTemplate.xls").Activate
ActiveSheet.Range(Cells((Row + 1), 1), Cells((Row + 1), 3)).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("data.xls").Activate
ActiveSheet.Range(Cells(Row, 5), Cells(Row, 29)).Select 'this will select the contents of the active row
Workbooks("blankTemplate.xls").Activate
ActiveSheet.Range(Cells((Row + 1), 5), Cells((Row + 1), 29)).Select
Selection.PasteSpecial Paste:=xlPasteValues
Next
Sub MoveText()
Dim shtData As Worksheet, shtTempl As Worksheet
Dim Row As Long
Set shtData = Workbooks("Data.xls").Sheets("Data") 'or e.g. .Sheets(1)
Set shtTempl = Workbooks("blankTemplate.xls").Sheets("Data")
For Row = 5 To 962
shtTempl.Cells(Row + 1, 1).Resize(1, 3).Value = _
shtData.Cells(Row, 1).Resize(1, 3).Value
shtTempl.Cells(Row + 1, 5).Resize(1, 25).Value = _
shtData.Cells(Row, 5).Resize(1, 25).Value
Next Row
End Sub