VBA Runtime Error 1004 "Application-defined or Object-defined error"
I have code VBA code written in MS Access 2010 (.mbd file) to write data into an Excel file (.xls file). Below is the code to write data into that excel file. When you run this code, it always throws Error#1004 "Application-defined or Object-defined
error". When you debug the code (F8) or run it (F5), it runs absolutely fine with out any issues. I am still not able to figure it out on what exactly the issue is. This code works fine when executed in MS Access 2007.
Below is thr code that's getting executed and when it fails, the focus is set on the 3rd last line of the code marked in double astriek mark.
Sub PopulateReport(appExcel As Object, testcam)
Dim Site As String, intRec As Integer, i As Integer, cnt As Integer, intRecSet As Integer, cntr As Integer
Dim F1 As String, F2 As String, F3 As String, F4 As String, F5 As String, F6 As String, F7 As String
Dim F8 As String, F9 As String, F10 As String, F11 As String, F12 As String, F13 As String, CAMDate As Date
Close
i = 0
cnt = 0
cntr = 0
Set cnn = CurrentProject.Connection
rec.Open "SELECT * FROM Site", cnn, adOpenStatic, adLockPessimistic
rec.MoveLast
rec.MoveFirst
intRec = rec.RecordCount
Do Until cnt = intRec
rec.MoveLast
rec.MoveFirst
rec.Move cnt
Site = rec(4)
Select Case Site
Case "Fort Worth"
cntr = 0
recset.Open "SELECT * FROM Employee", cnn, adOpenStatic, adLockPessimistic
recset.MoveLast
recset.MoveFirst
intRecSet = recset.RecordCount
appExcel.Application.Goto Reference:="START_FW_CL"
Do Until cntr = intRecSet - 1
appExcel.Selection.EntireRow.Copy
appExcel.Selection.EntireRow.Insert
cntr = cntr + 1
Loop
appExcel.Application.CutCopyMode = False
appExcel.Application.Goto Reference:="START_FW2_CL"
go = appExcel.Application.Range("START_FW2_CL")
cntr = 1
With appExcel.Worksheets("Accts. > Clearing").[START_FW2_CL]
Do Until recset.EOF
**.Offset(cntr, 0) = recset(0)**
.Offset(cntr, 1) = recset(1)
.Offset(cntr, 2) = recset(2)
End Sub
What's wrong about it? It can only copy what you chose to have in the recordset. If you only want some fields or fields in a different order, replace
SELECT * FROM with
SELECT Field1, Field2, etc
CopyFromRecordset is bay far the best method and runs much faster.
Rod Gill
Author of the one and only Project VBA Book
www.project-systems.co.nz
Similar Messages
-
Run-time error '1004' Application-Defined or object-defined error
Hello friends,
My requirement is to make the cells under Columns Actual, forecast and target (Dimesnion Category) Locked.
I've used various methods like GetOnlyRange but it didnt work.
Now, i've selected all the cells of the sheet, where user can input and made them unlocked. ( from Right-click>FormatCells>Protection tab-->Locked checkbox unchecked)
Then, go to "review" tab, click "Allow Users to edit Ranges",-> Protect Sheet---> ticked "Unlocked Cells"
Then go to WorkBook Options and set a password for the worksheet.
But on expand, I'm facing Run-time error '1004' Application-Defined or object-defined error.
Please help.
Please help.Hi,
I think that is VBA Runtime error, you can fix these errors by downloading in various sites.
http://www.articlesbase.com/data-recovery-articles/vba-runtime-error-1004-application-defined-or-object-defined-error-fix-these-errors--1339060.html
You can try with the above link. I hope this could solve your problem.
Regards,
B.S.RAGHU -
Runtime Error 1101. Application-defined or object-defined error
I am updating VBA code from MS project 2003 plans to 2013, and have come up with the following error message.
Run-time error 1101: Application-defined or object-defined error.
Any help to remedy the situation would be greatly appreciated.
Thanksjfrh,
Normally you shouldn't have to make any changes to VBA written under Project 2003 in order for it to work with later versions however sometimes certain statements may need some "tweaking".
The general description of the run-time error doesn't help us much unless we know a little bit more about your macro. We don't necessarily need to see the whole macro but we do need some context as a starting point. What is the macro supposed to do generally?
Which line of code is highlighted when the error occurs?
John -
Application-defined or Object-defined error
Hello,
When I open Input schedule through open dynamic templates I get the following error message
Application-defined or Object-defined error
Version : BPC 7.0
SP05
Request your guidance.
Thanks,
RamsivaI have experienced much the same problem which I have documented in details here:
Excel Spreadsheet being opened in preview mode by some machines
(Note that I am only surmising the preview mode is the problem as I get the exact same error if I open it on the Development machine in preview mode).
My only workaround at the moment is to open the spreadsheet on the target machine and then replace the vba code and save the file locally (Copy Paste), or apply a digital certificate to the existing VBA code, although the latter only seems to work sometimes.
If I fix the problem on the target machine and then copy, open and close the file on the development machine when the file is sent back to the target machine the problem occurs again.
I have ruled out emailing being the problem as I have copied the file instead of emailing.
The development machine had a number of Office applications and Windows 7 updates applied around the time that the problem occurred, i.e. one day everything is fine, the next day it is impossible to run a new spreadsheet on certain machines.
The highlighted error is also with a .select statement but I isolated the code and put it into a test spreadsheet and that ran okay so it seems to be a more subtle problem.
It doesn't happen on all the machines and I can't see any pattern as to what machines it works on and those it doesn't. They are mostly Windows 7 64bit running Office 2010 and 2013, seems to be about 50/50 split as to working and not working.
I've ensured that the Windows Updates are up to date on all the problem machines.
I think it is the same problem and it helps knowing that someone else has experienced the same thing in order that I don't think I'm going crazy but it's a major problem for me and none of the suggestions so far seem to be close to explaining what is going
on.
If anyone wants samples in order to investigate the problem I am more than happy to send them the spreadsheets. -
Run-time error '1004' -- Method 'Container' of object '_Workbook' failed
Dear All,
One of our users is getting the following Microsoft Visual Basic error while running the report S_ALR_87013614.
Run-time error '1004'
Method 'Container' of object '_Workbook' failed.
I have searched the forum posts for help. But I only found some details related to Run-time error 1004 related to some excel file security but not related to "Method 'Container' of object '_Workbook' failed".
Could anyone please tell me how this error can be eliminated for the user?
Regards,
Lakshmi.Dear Arpan,
We too observed a few PIDs along with the one that you have mentioned but they make no difference. Some users who has the PID G_RW_DOCUMENT_TYPE set with some value are getting the report.
Upon further searching we are assuming that it could be an issue with the Microsoft applications or macro settings of the user. But not sure about it.
Regards,
Lakshmi Venigala. -
Hello All,
I tried to Import Goods Issue in SAP B1, but I got Error as below
“ Enter valid code [IGE1.tem code][line1036] application-defined or object defined error65171 “
Anyone please suggest me what would be the cause of this error.
Regards,
HitulHi,
1. Make sure correct item code entered at row level.
2. Please refer SAP note 3.2 for solution.
865191
- Data Transfer Workbench (DTW) Troubleshooting Guide
3. Are you importing more than 1000 rows?
Thanks & Regards,
Nagarajan -
"Illegals parent number Application-defined or object defined error65171"
HI Experts,
I am trying to import a Chart of Account for a new company and I get this error message "Illegals parent number Application-defined or object defined error65171"
I have seen a couple of post on this topic but I can't pick out the exact thing I'm doing wrong. Can anybody please put me through?
If you can give me an email addres I can send the csv for so you can take a look, it format gets disrupted when I paste it here.
Waiting to Hear from you.
RegardsDear,
For your issue, If you are using non-segmentation account, please kindly check whether your
fatherAccountKey is empty or not, this column is mandatory field for non-segmentation account.
If you are trying to update chart of account with segmentation, please check the note 942939 below:
Symptom
When you try to update chart of account with segmentation, using the
standard template of DTW 2005, you will receive the error message
"Cannot find this object in B1 Application-defined or object - defined
error 65171.
Other terms
DTW; update; chart of account; SAP Business One;
Reason and Prerequisites
Possible reason:
1, Field 'Code' is blank.
In DI API Help file 2005 for OChartofAccount, it says that Field "Code"
is the Mandatory field in SAP Business One when Not Working with
Segmentation.
2, Field 'FormatCode'
The Account Segment Separator '-'.existed in 'FormatCode' field.
Solution
1, Field 'Code' is blank.
For updating existing chart of account with segmentation, This field is
mandatory. You must fill it with the account code of that account you
want to update. You can get the code of each account #_SYS00000000XX#
from OACT table. Otherwise, we cannot update it.
It is not covered in DI API Help file 2005.
2, Field 'FormatCode'
Please delete the Account Segment Separator '-'. For example, change
11005-000-00-11 to 110050000011. System will identify automatically.
Please make sure that the field is a Text format cell. You can change
the format cell by right click the cell.
Wish the information above could solve your issue.
Regards
Apple -
DTW - COA error Illegal parent numberApplication-defined or object-defined
Hi friends,
I am getting error "Illegal parent numberApplication-defined or object-defined errorchartOfAccounts"
while executing DTW - COA.
I am using country India verson and new company is created with user defined COA option.
I have used 100000000000000 to 500000000000000 as parent code for 2nd level accounts as the same is standard drawers for Country India version Chart of Account at level 1.
Can anybody throw some light on this ?
Thanks,
Samir Gandhi
Edited by: Samir Gandhi on Oct 15, 2008 11:51 AMSuda,
Below find the sample in code tag.
Code AccountType AcctCurrency ActiveAccount AllowChangeVatGroup BudgetAccount CashAccount DataExportCode DefaultVatGroup Details ExternalCode FatherAccountKey ForeignName FormatCode LiableForAdvances LockManualTransaction Name ProjectCode Protected RateConversion ReconciledAccount RevaluationCoordinated TaxExemptAccount TaxLiableAccount
Code AccountType AcctCurrency ActiveAccount AllowChangeVatGroup BudgetAccount CashAccount DataExportCode DefaultVatGroup Details ExternalCode FatherAccountKey ForeignName FormatCode LiableForAdvances LockManualTransaction Name ProjectCode Protected RateConversion ReconciledAccount RevaluationCoordinated TaxExemptAccount TaxLiableAccount
tNO tNO tNO 100000000000000 10000000 tNO ASSETS tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10000000 10100000 tNO Fixed Assets tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10100000 10101000 tNO Fixed Assets-Tangible tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10101000 10101100 tNO Free Hold Land tNO tNO tNO tNO tNO tNO
at_Other INR tYES tNO tNO 10101100 10101101 tNO Free Hold Land tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10101000 10101200 tNO Lease Hold Land tNO tNO tNO tNO tNO tNO
at_Other INR tYES tNO tNO 10101200 10101201 tNO Lease Hold Land tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10101000 10101300 tNO Factory Building tNO tNO tNO tNO tNO tNO
at_Other INR tYES tNO tNO 10101300 10101301 tNO Factory Building tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10101000 10101400 tNO Non-Factory Building tNO tNO tNO tNO tNO tNO
at_Other INR tYES tNO tNO 10101400 10101401 tNO Non-Factory Building tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10101000 10101500 tNO Plant & Machinery tNO tNO tNO tNO tNO tNO
at_Other INR tYES tNO tNO 10101500 10101501 tNO Plant & Machinery tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10101000 10101600 tNO Electric Supply System tNO tNO tNO tNO tNO tNO
at_Other INR tYES tNO tNO 10101600 10101601 tNO Electric Supply System tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10101000 10101700 tNO Vehicles tNO tNO tNO tNO tNO tNO
at_Other INR tYES tNO tNO 10101700 10101701 tNO Vehicles tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10101000 10101800 tNO Furniture & Fittings tNO tNO tNO tNO tNO tNO
at_Other INR tYES tNO tNO 10101800 10101801 tNO Furniture & Fittings tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10101000 10101900 tNO Office Equipments tNO tNO tNO tNO tNO tNO
at_Other INR tYES tNO tNO 10101900 10101901 tNO Office Equipments tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10100000 10102000 tNO Fixed Assets-InTangible tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10102000 10102100 tNO "Concessions,Patents,Licences,Trademarks,etc." tNO tNO tNO tNO tNO tNO
at_Other INR tYES tNO tNO 10102100 10102101 tNO Trade Marks tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10102000 10102200 tNO Goodwill tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10100000 10200000 tNO Accumulated Depreciation - Tangible Assets tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10200000 10201100 tNO Free Hold Land tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10200000 10201200 tNO Lease Hold Land tNO tNO tNO tNO tNO tNO
tNO tNO tNO 10200000 10201300 tNO Factory Building tNO tNO tNO tNO tNO tNO
Thanks,
Samir Gandhi -
Runtime Error '1004':, Method 'Intersect' of object '_Global' failed
Hello
I am getting a runtime error 1004, can someone tell me why? I am getting the runtime error on the first Application.Intercept statement.
Thank you for your help!
smsemail
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Not Application.Intersect(Target, Me.Range("A:A")) Is Nothing Then
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If lastRow < 17 Then
Exit Sub
End If
If lastRow > 67 Then
lastRow = 67
End If
Else
Exit Sub
End If
If Not Application.Intersect(Target, Me.Range("A17:A" & lastRow)) Is Nothing Then
Application.EnableEvents = False
If Application.WorksheetFunction.CountA(Worksheets("RIPS").Range("A17:A67")) = 0 Then
Exit Sub
End If
If Application.WorksheetFunction.CountA(Worksheets("RIPS").Range("B17:B67")) = 0 And _
Application.WorksheetFunction.CountA(Worksheets("RIPS").Range("C17:C67")) = 0 And _
Application.WorksheetFunction.CountA(Worksheets("RIPS").Range("D17:D67")) = 0 Then
Exit Sub
End If
If CmdExecute = True Then
Exit Sub
End If
If CmdClear = True Then
Exit Sub
End If
Worksheets("RIPSSummary").Activate
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Set SourceRange = Application.Intersect(Range("A2:A" & lastRow), ActiveSheet.UsedRange)
MsgBox "Source Range: " & SourceRange
Worksheets("RIPS").Activate
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Set TargetRange = Application.Intersect(Range("A17:A" & lastRow), ActiveSheet.UsedRange)
MsgBox "Target Range: " & TargetRange
Exit Sub
wsDeleted = False
For Each acell In SourceRange.Cells
RecordFound = True
If Not IsEmpty(acell.Value) Then
Set C = TargetRange.Find(acell.Value, LookIn:=x1values)
If C Is Nothing Then
RecordFound = False
End If
If RecordFound = False Then
wsDeleted = True
For Each Worksheet In Worksheets
If Worksheet.Name = acell.Value Then
Worksheet.Delete
End If
Next Worksheet
End If
End If
Next acell
If vbKeyDelete Or _
vbKeyClear Then
r = lastRow
Do Until r < 17
If Worksheets("RIPS").Range("A" & r).Value = "" Then
Rows(r).Delete
End If
r = r - 1
Loop
End If
Application.EnableEvents = True
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End SubIt should work but maybe there's something about your workbook we can't see.
In passing generally best not to disable screenupdating, alerts or events unless need to do so. More importantly though you should ensure they always get reset. As written you have several Exit Sub's before any code that resets them. Also in case of an error
consider resetting them in an error handler. -
Also when I am in a site, such as an account, and click on a highlighted link, I get another error, {Javascript Application] can't create mcafee plug-in object: Type Error: components. classes [cid] is undefined. The only mcafee I had on my computer was the secure search and I uninstalled it, but I still get this message. When I click on the OK button with the error message, then the link opens up.
Start Firefox in [[Safe Mode]] to check if one of the add-ons is causing the problem (switch to the DEFAULT theme: Tools > Add-ons > Appearance/Themes).
* Don't make any changes on the Safe mode start window.
See:
* [[Troubleshooting extensions and themes]] -
Excel Application-defined or object-defined error 32809
This error occurs on files that are received from outside our company network.
A file created on our company network, sent to customers (a technical questionnaire) who then complete and return them, no longer works correctly. This occurs when the file is sent by email or on a USB drive and is opened and then saved, even with no changes.
The Excel version is 2010 32 bit on Win8 64 bit machines
The error triggers in many different VBA sub routines on lines such as Sheets("Home").Select, and on lines in the immediate window such as Print Activesheet.nameI have experienced much the same problem which I have documented in details here:
Excel Spreadsheet being opened in preview mode by some machines
(Note that I am only surmising the preview mode is the problem as I get the exact same error if I open it on the Development machine in preview mode).
My only workaround at the moment is to open the spreadsheet on the target machine and then replace the vba code and save the file locally (Copy Paste), or apply a digital certificate to the existing VBA code, although the latter only seems to work sometimes.
If I fix the problem on the target machine and then copy, open and close the file on the development machine when the file is sent back to the target machine the problem occurs again.
I have ruled out emailing being the problem as I have copied the file instead of emailing.
The development machine had a number of Office applications and Windows 7 updates applied around the time that the problem occurred, i.e. one day everything is fine, the next day it is impossible to run a new spreadsheet on certain machines.
The highlighted error is also with a .select statement but I isolated the code and put it into a test spreadsheet and that ran okay so it seems to be a more subtle problem.
It doesn't happen on all the machines and I can't see any pattern as to what machines it works on and those it doesn't. They are mostly Windows 7 64bit running Office 2010 and 2013, seems to be about 50/50 split as to working and not working.
I've ensured that the Windows Updates are up to date on all the problem machines.
I think it is the same problem and it helps knowing that someone else has experienced the same thing in order that I don't think I'm going crazy but it's a major problem for me and none of the suggestions so far seem to be close to explaining what is going
on.
If anyone wants samples in order to investigate the problem I am more than happy to send them the spreadsheets. -
Cisco CRS Historical Reports error "run time error 364 application defined or object-defined error"
Hi All,
we are getting an error when we open historical reportHi;
The 713 error generally means something is not installed correctly for the runtime.
How did you deploy the runtime to the client system?
Regards,
Jonathan -
Err: Non-valid period-application defined or object defined error orders
Hi
Please solve above error
When importing the Sales Order Data i got this error.
I don't undertstand yet this error
Please help me
Kishorkishor,
Please help us, help you.
You have to provide more information in order for us to understand the problem.
Where were you? (indicate what module and form you were working in).
What were you doing? (please state every step you made in the form).
What was the complete error message?
Best Regards,
Vítor -
Runtime error 32809 Application or object defined
My code is used by six different remote sites [exact same code]. I made some changes to the code, export the changed modules to a file which is then imported in the various site's program. Before I sent the code to the user I run a test to ensure there's
no problems. I've being doing this for some time without any hazels. No suddenly I get this message on some of the sites at different areas of the code. For instance this is some part of my code:
If ActiveSheet.name = "ABC" then tSer [public decl as long] = 5
If ActiveSheet.name = "DEF" then tSer = 6
If ActiveSheet.name = "GHI" then tSer = 7
I get the error on the first line [ABC]. My limited VBA knowledge tells me even if sheet ABC does not exits, the code should do the next test?
Any assistance would be much appreciated! I search for error code 32809 - No results.
Tank youHello Hennie,
The
Excel Application-defined or object-defined error 32809 forum thread states the following:
Many users have run into this problem recently. This could be caused by an update for the Office application. Please take a look at this thread:
https://social.technet.microsoft.com/Forums/en-US/473b1980-56b3-49ff-be71-3a60c0db048b/form-controls-stop-working-after-december-2014-updates?forum=excel
There's a probabability that the customers outside the corperate network had installed the update, so when they opened the workbook you created, it damage the workbook. Please try the solutions provided in the thread.
Also some users work around by adding some inconsequential comments after the Select method, or create a brand new workbook then copy the data and VBA code in it. -
I have a workbook with VBA and I am getting a 'Run-time Error 1004' and when I hit the debug the process stops at below lines of codes:
' Insert blank rows, one to hold each period and one for the total line
With resultArea.Cells(RowNum, KeyFigCol - 1) {it says Application defined or Object defined error}
If .Value <> "" Then
I saw other threads for this error and I checked the OSS-429183. Also my macro>>security is set to low.
Any suggestions? Plus I am getting this error only in dev environment, stage & production work fine. I have verified the VBA code and they all have same code.Hi All, I still have this problem. I have the same VBA code in all the systems, but it gets error in development system only. its working fine in other systems. That's what breaks my head:(
Any suggestions. I have attached my VBA code.
'* Variable Declarations
Dim Column As Integer
Dim StrPos As Long
Dim TempStr As String
Dim RowNum As Integer
Dim StrRowNum As Integer
Dim EndRowNum As Integer
Dim EndColNum As Integer
Dim KeyFigCol As Integer
Dim DelStrCol As Integer
Dim LabelPos As Integer
Dim ActiveCellSave As String
Dim MonthFlag As String
Dim MonthFlagPrev As String
Dim MonthColStr As Integer
Dim MonthColEnd As Integer
Dim MonthCol1st As Integer
Dim MatMonRow As Integer
Dim ColPrjAvl As Integer
Dim ColTopGrn As Integer
Dim ColTopYel As Integer
Dim ColTopRed As Integer
Dim ColRmdRpl As Integer '001A
Dim ColMaxQty As Integer
Dim ColRplQty As Integer
Dim First As Boolean
Dim NumPeriods As Integer '001A
Dim UsgPerDay As Integer '001A
Dim StartTime
Dim EndTime
' Check the query id to determine which sheet to activate
If queryID = "SAPBEXq0016" Then 'Monthly Query
'Application.ScreenUpdating = False
'Set sheet "Inventory Montly Analysis" to active
Sheets(3).Activate
NumPeriods = 13 '001A
'* 001A: Set "Inventory Weekly Analysis" to active
ElseIf queryID = "SAPBEXq0018" Then ' Weekly query
Sheets(4).Activate
NumPeriods = 24
'* 001A: Set "Inventory Replenishment" to active
ElseIf queryID = "SAPBEXq0017" Then ' Replenishment Detail query
Sheets(6).Activate
NumPeriods = 0
Else
Exit Sub
End If
'* 001A: End of new code
'* Initialization Routines
First = True
' For performance testing, save off the start time of the macro
StartTime = Time
' Save off the current cell location so that we can restore that location
' when formatting is compelte
ActiveCellSave = ActiveCell.Address()
If ActiveCell.Value <> "No applicable data found." Then
' Determine the First Row in the spreadsheet where query results are displayed
' The first row will be stored in variable RowNum
TempStr = resultArea.Address(RowAbsolute:=False, ColumnAbsolute:=False)
StrRowNum = 0
Do While StrRowNum = 0
StrRowNum = Val(TempStr)
If StrRowNum = 0 Then
TempStr = Mid(TempStr, 2, 20)
End If
If TempStr = "" Then
Exit Do
End If
Loop
' Determine the Last Row in the spreadsheet where query results are displayed
' The last row will be stored in variable EndRowNum
TempStr = resultArea.Address(RowAbsolute:=False, ColumnAbsolute:=False)
StrPos = InStr(TempStr, ":")
TempStr = Right(TempStr, Len(TempStr) - StrPos)
EndRowNum = 0
Do While EndRowNum = 0
EndRowNum = Val(TempStr)
If EndRowNum = 0 Then
TempStr = Mid(TempStr, 2, 20)
End If
If TempStr = "" Then
Exit Do
End If
Loop
' Determine the Last Column in the spreadsheet where query results are displayed
' The last column number will be stored in EndColNum
TempStr = resultArea.Address(RowAbsolute:=False, ColumnAbsolute:=False, ReferenceStyle:=xlR1C1)
StrPos = InStr(TempStr, ":")
If StrPos > 0 Then
TempStr = Right(TempStr, Len(TempStr) - StrPos)
StrPos = InStr(TempStr, "C")
If StrPos = 0 Then
EndColNum = 255
Else
TempStr = Right(TempStr, Len(TempStr) - StrPos - 1)
EndColNum = Val(TempStr)
End If
End If
' Clear all of the old contents below the query result area
TempStr = Format(EndRowNum + 1) + ":" + Format(65536)
ActiveSheet.Rows(TempStr).Select
Selection.Clear
' Determine the location of various key figure columns needed in subsequent processing
KeyFigCol = 0
For Column = 1 To EndColNum
' Find the start column for the key figures - Indicated by the first column
' with a dash "-" character in it.
If InStr(resultArea.Cells(1, Column).Value, " - ") <> 0 Then
If KeyFigCol = 0 Then KeyFigCol = Column
End If
' Find the Projected Available Column
If (ColPrjAvl = 0) And (InStr(resultArea.Cells(1, Column).Value, "Proj") <> 0) Then
ColPrjAvl = Column
End If
' Find the Top of Green Column
If (ColTopGrn = 0) And (InStr(resultArea.Cells(1, Column).Value, "Top of Green") <> 0) Then
ColTopGrn = Column
End If
' Find the Top of Yellow Column
If (ColTopYel = 0) And (InStr(resultArea.Cells(1, Column).Value, "Top of Yellow") <> 0) Then
ColTopYel = Column
End If
' Find the Top of Red Column
If (ColTopRed = 0) And (InStr(resultArea.Cells(1, Column).Value, "Top of Red") <> 0) Then
ColTopRed = Column
End If
' Find the Recommended Replenishment Quantity
If (ColRmdRpl = 0) And (InStr(resultArea.Cells(1, Column).Value, "Recommended Replenishment Qty") <> 0) Then
ColRmdRpl = Column
End If
' Find the Usage Per Day
If (UsgPerDay = 0) And (InStr(resultArea.Cells(1, Column).Value, "Usage Per") <> 0) Then
UsgPerDay = Column
End If
' Find the Maximum Order Column
If (ColMaxQty = 0) And (InStr(resultArea.Cells(1, Column).Value, "Maximum Order Quantity") <> 0) Then
ColMaxQty = Column
End If
' Find the Recommended Replenishment Column
If (ColRplQty = 0) And (InStr(resultArea.Cells(1, Column).Value, "Recommended Replenishment") <> 0) Then
ColRplQty = Column
End If
Next Column
'* Begin of main formatting loop
'* Logic for Recommended Repl Highlighting
If NumPeriods = 0 Then
' Highlight the Recommended Replenishment Quantity
For RowNum = 2 To EndRowNum
If resultArea.Cells(RowNum, ColRplQty).Value > resultArea.Cells(RowNum, ColMaxQty).Value Then
resultArea.Cells(RowNum, ColRplQty).Interior.ColorIndex = 7 'Highlight Red
End If
Next RowNum
'* Logic for Monthly and Weekly Queries
Else
' Work from the bottom up, inserting new lines and folding the keyfigures
' downward into one row for each month
For RowNum = EndRowNum To 2 Step -1
' Insert blank rows, one to hold each period and one for the total line
With resultArea.Cells(RowNum, KeyFigCol - 1) This is where it stops & gives Runtime Error 1004
If .Value <> "" Then
' For the bottom-most characteristic row, we must cut and paste differently to ensure
' the cells formats are properly pasted in the new rows
If First Then
TempStr = Format(RowNum) + ":" + Format(RowNum + NumPeriods)
resultArea.Rows(TempStr).Select
Selection.Insert Shift:=xlDown
resultArea.Rows(RowNum + NumPeriods + 1).Select
Selection.Cut
resultArea.Rows(RowNum).Select
ActiveSheet.Paste
First = False
' If this is the first characteristic record, and it resides in row 2, then we know that the
' query only has one row of data - special formatting is required in this situation
If RowNum = 2 Then
resultArea.Cells(2, 1).Select
Selection.Copy
Range(ActiveSheet.Cells(StrRowNum + 2, 1), ActiveSheet.Cells(EndRowNum + NumPeriods, KeyFigCol - 1)).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
' Not the first row, use normal processing
Else
TempStr = Format(RowNum + 1) + ":" + Format(RowNum + NumPeriods)
resultArea.Rows(TempStr).Select
Selection.Insert Shift:=xlDown
End If
' As we insert rows for each characteristic row, we need to adjust the end row
' number accordingly
EndRowNum = EndRowNum + NumPeriods
' Initialize variables used for each set of month processing
MatMonRow = RowNum + 1
MonthFlagPrev = ""
MonthFlag = ""
MonthColStr = 0
' Scan key figure column headings from left to right, looking for changes in month
For i = KeyFigCol To EndColNum + 1
' Get the month text for each column
MonthFlag = ""
TempStr = resultArea.Cells(1, i).Value
MonthFlag = Mid(TempStr, InStr(TempStr, "-") + 1, 15)
' If we move into a new month, then copy and paste the previous month downward
If ((MonthFlag <> MonthFlagPrev) And (MonthFlagPrev <> "")) Or (i = EndColNum + 1) Then
If DelStrCol = 0 Then DelStrCol = i + 1 ' Capture last key figure of first month
If i = EndColNum + 1 Then i = i + 1 'For results row, need to extend by one
' Copy and paste values for previous month
Range(resultArea.Cells(RowNum, MonthColStr), resultArea.Cells(RowNum, i - 1)).Select
Selection.Copy
resultArea.Cells(MatMonRow, MonthCol1st).Select
ActiveSheet.Paste
' Paste the Month text into the row heading
resultArea.Cells(MatMonRow, MonthCol1st - 1).Value = MonthFlagPrev
If MonthFlagPrev = " Average Result" Then
Range(resultArea.Cells(MatMonRow, MonthCol1st - 1), resultArea.Cells(MatMonRow, EndColNum)).Select
Selection.Interior.ColorIndex = 36
End If
With resultArea.Cells(MatMonRow, ColPrjAvl)
If .Value >= resultArea.Cells(RowNum, ColTopGrn).Value Then
.Interior.ColorIndex = 43 'Green Green
ElseIf .Value >= resultArea.Cells(RowNum, ColTopYel).Value Then
.Interior.ColorIndex = 14 'Green
ElseIf .Value >= resultArea.Cells(RowNum, ColTopRed).Value Then
.Interior.ColorIndex = 44 'Yellow
Else
.Interior.ColorIndex = 7 'Red
End If
End With
MonthColStr = i
MatMonRow = MatMonRow + 1
End If
' Set variables on first pass through
If MonthColStr = 0 Then
MonthColStr = i
MonthCol1st = i
MonthFlagPrev = MonthFlag
End If
' Capture the previous month text
If MonthFlagPrev <> "" Then
MonthFlagPrev = MonthFlag
End If
Next i
' Clear out the key figure data at the lowest characteristic level
Range(resultArea.Cells(RowNum, KeyFigCol), resultArea.Cells(RowNum, EndColNum)).Select
Selection.ClearContents
End If
End With
Next RowNum
' Strip out the month text from column headings
For i = KeyFigCol To DelStrCol
LabelPos = InStr(resultArea.Cells(1, i).Value, "-")
If LabelPos > 1 Then resultArea.Cells(1, i).Value = _
Left(resultArea.Cells(1, i).Value, LabelPos - 1)
Next i
' Remove Extraneous columns (months 2-12)
Range(resultArea.Cells(1, DelStrCol - 1), resultArea.Cells(EndRowNum, EndColNum + 1)).Select
Selection.Clear
' Format Column Headings with appropriate column widths and heights
resultArea.Rows(1).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 1
.ShrinkToFit = False
.MergeCells = False
.RowHeight = 31.5
End With
' 001A: Add empty cells for Recommended replenishment
If ColRmdRpl <> 0 Then
For i = 2 To EndRowNum
If resultArea.Cells(i - 1, 1) = "" Then
Range(resultArea.Cells(i, ColRmdRpl), resultArea.Cells(i, ColRmdRpl + 4)).Insert Shift:=xlToRight
End If
Next i
Columns(ColRmdRpl + 5).Copy
Range(Columns(ColRmdRpl), Columns(ColRmdRpl + 4)).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
If UsgPerDay <> 0 Then
For i = 2 To EndRowNum
If resultArea.Cells(i - 1, 1) = "" Then
resultArea.Cells(i, UsgPerDay).Insert Shift:=xlToRight
End If
Next i
Columns(ColRmdRpl + 5).Copy
Range(Columns(ColRmdRpl), Columns(ColRmdRpl + 4)).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
End If
For i = 3 To EndRowNum
If resultArea.Cells(i - 1, 1) <> "" Then
Range(resultArea.Cells(i, ColRmdRpl + 1), resultArea.Cells(i + NumPeriods - 1, ColRmdRpl + 4)).Select
Selection.FillDown
Range(resultArea.Cells(i, UsgPerDay), resultArea.Cells(i + NumPeriods - 1, UsgPerDay)).Select
Selection.FillDown
End If
Next i
' Remove Extraneous columns (months 2-12)
Range(resultArea.Cells(1, DelStrCol - 1), resultArea.Cells(EndRowNum, EndColNum + 1)).Select
Selection.Clear
End If
' 001A: End of new code
End If
End If
Columns("A:BA").ColumnWidth = 10
resultArea.Columns.AutoFit
' Set Zoom level at 75%
ActiveWindow.Zoom = 75
' Restore the active cell
Range(ActiveCellSave).Select
' EndTime = Time
' MsgBox StartTime
' MsgBox EndTime
' StartTime = EndTime - StartTime
' MsgBox StartTime
' End If
' End If
'Application.ScreenUpdating = True
End Sub
Maybe you are looking for
-
Problem with sound in games requiring quicktime
I recently purchased CSI 1. I installed the game and the latest version of quicktime player. As soon as the game starts and the first character starts talking the game pauses as if loading and then plays for a second and pauses again for a few second
-
No local string defined -- Inconsistent Module State
I am trying to deploy an Enterprise Application and during compilation I get the following error. Any idea? I am using Sun Java System Application Server 8.1 and jdk1.5.0_08, javax.enterprise.system.tools.deployment|_ThreadID=14;|Se produjo una excep
-
In premier elements ...how do you render the menu screen?
I have Premier Elements . Do you render the menu screens for more clarity?
-
Embed Lightroom Slideshow in Activerain Blog
I've been trying (in vain) to embed a Lightroom slideshow into my activerain blog here: http://activerain.com/blogsview/658980/Homes-Near-Peterson-and The slideshow should be in that big blank white space near the bottom of the post. I'm hosting the
-
I had recently had to reinstall windows on my computer and I know that I am regretably using older software for installation but before doing so I did have itunes on my computer and now tryin to install it I keep geting the same problem at the point