The issue I've got here is that
iRow = PullRange.Find(What:=a(x, 0)).Row - 1
Throws above mentioned error in the middle of a loop. The thing is it works for the first handful of iterations of x, but at x = 11/iRow = 30 it breaks and I've no clue why. There's nothing unique about that particular row and yet it crashes, has anyone any clue as to why?
Let me know if more info is needed.
Public Sub DataDump(Sql As String, PullColumn As String)
Dim a() As Variant
Dim iRow As Integer
Dim PullRange As Range
Dim DumpRange As Range
Dim x As Integer
Dim y As Integer
Set PullRange = Range(PullColumn & ":" & PullColumn)
Set DumpRange = Range("H1")
Set recs = New ADODB.Recordset
recs.Open Sql, con, adOpenDynamic
a = recs.GetRows
'a(y, x)
For x = 0 To UBound(a, 2)
If IsNull(a(0, x)) Then GoTo none
iRow = PullRange.Find(What:=a(0, x)).Row - 1
If iRow = 0 Then GoTo none
For y = 1 To UBound(a, 1)
Debug.Print a(y, x)
If IsNull(a(y, x)) Then GoTo Err
DumpRange.Offset(iRow, y) = a(y, x)
Err:
Next y
none:
Next x
End Sub
#Rory Was right. Unclean data caused the loop to break and I couldn't see the difference because the difference was minute, after inserting data set anew from the same source it fixed itself. Lesson learned.
Related
On the Model.Calculate Line, I get an error.
The error is "Cannot execute code in breakmode"
Anything wrong with the code? NOTE: TM1 Addin Is enabled and must be.
Sub Status_Quo_Sensitivity()
Dim wb As Workbook, Summary As Worksheet, Inputs As Worksheet, Model As Worksheet
Dim SenRange As Range, Reductions(1 To 5) As Double
Dim ReducCell As Range
Dim val As Integer, num As Integer
Set Summary = ThisWorkbook.Worksheets("SUMMARY")
Set Inputs = ThisWorkbook.Worksheets("INPUTS")
Set Model = ThisWorkbook.Worksheets("MODEL")
Set SenRange = Summary.Range("K15:K19")
Set ReducCell = Inputs.Range("D17")
For val = 1 To 5
Reductions(val) = Summary.Cells(13, val + 8).Value
Next val
For num = LBound(Reductions) To UBound(Reductions)
Inputs.Cells("D17") = Reductions(num)
Model.Calculate
Summary.Calculate
SenRange.Copy
Inputs.Range(Inputs.Cells(15, 8 + num), Inputs.Cells(19, 8 + num)).PasteSpecial xlPasteValues
Next num
Inputs.Cells("D17")
to
Inputs.Range("D17")
Found a similar post on this question, but it was using an SQL Query and I'm using a DLookup.
I'm importing an Excel sheet to Access.
I'm getting the run-time 3075 - Syntax error (missing operator)... '[Component]='don't have/want a car'.
That particular Component already exists in the DB and it errors out at the comparison.
It's either the ' or the / that are causing the hang-up
Oh and I went with Variant on the tmpComponent b/c if I go String I get an Object required error at the Set tmpComponent = ... line. Maybe that is the problem, just not really sure.
Here is my Code and the bold is where the error occurs.
Thank you in advance for any direction you can provide.
Set rsCat = db.OpenRecordset("Categories", dbOpenDynaset, dbSeeChanges)
Dim x As Integer: x = 2
Dim LRow As Integer: LRow = ExLWb.Sheets("Categories").Cells(Rows.Count, 2).End(xlUp).Row
Dim tmpPFId As Variant, tmpCategory As Variant, tmpComponent As Variant, tmpSyntax As Variant, tmpCycle As Variant
Dim NewItem As Integer
NewItem = 0
'******************* LOOP THROUGH SPREADSHEET UPDATING CATEGORY TABLE
For x = 2 To LRow
Set tmpPFId = ExLWs.Cells(x, 2)
Set tmpCategory = ExLWs.Cells(x, 3)
Set tmpComponent = ExLWs.Cells(x, 4)
Set tmpSyntax = ExLWs.Cells(x, 5)
Set tmpCycle = ExLWs.Cells(x, 9)
**If IsNull(DLookup("[Component]", "[Categories]", "[Component]= '" & tmpComponent & "'")) Then**
rsCat.AddNew
rsCat!PF_ID = tmpPFId
rsCat!Category = tmpCategory
rsCat!component = tmpComponent
rsCat!Syntax = tmpSyntax
rsCat!Active = True
rsCat!Available = True
rsCat!Cycle = tmpCycle
rsCat.Update
NewItem = NewItem + 1
End If
Next x
Disregard, I figured out I should have gone with:
If IsNull(DLookup("[Category]", "[Categories]", "[Category]= """ & tmpCategory & """ & [Component]= """ & tmpComponent & """")) Then
I have a larger code set to help automate an auditing model. I am attempting to add a function to import a claims file. I have a "GetFiles" function I use regularly to import information but now I am receiving type mismatch error.
I have already tried different variable assignments and fully quantifying different items but it appears to err out regardless. Originally I was doing OpenFile = GetFiles (see commented line) and then my formula read as set aux = application.workbooks.open(OpenFile) but same error
This is a small section of the code so a number of the variables declared are not visible in this snippet.There is also some commented out lines regarding "ThisWorkbook" as the module will be moved from my personal working file into an actual template model.
Sub Audit_Template_Autofill()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim column_id() As Variant, A1 As Range, Z As Range, c As Range
Dim column_count As Long, x As Long, input_option() As Variant, Loop_Input As Variant
Dim claims As Worksheet, audit As Worksheet, OpenFile As Variant, aux As Workbook
'run function to get claims file for import
'GetFiles
' Set claims = ThisWorkbook.Sheets("Claims Data")
' Set audit = ThisWorkbook.Sheets("Audit")
Set claims = ActiveWorkbook.Sheets("Claims Data")
Set audit = ActiveWorkbook.Sheets("Audit")
'OpenFile = GetFiles
Set aux = Application.Workbooks.Open(GetFiles)
ActiveWorkbook.ActiveSheet.Cells.Select.Copy
claims.Range("A1").Paste
Set A1 = claims.Range("A1")
Set Z = A1.End(xlToRight).Offset(0, 1)
column_count = claims.Range(A1, Z).Count
ReDim column_id(0 To column_count): ReDim input_option(0 To column_count)
For Each c In Range(A1, Z)
column_id(x) = c.Value
x = x + 1
Next c
x = 0
Do While x <= column_count
input_option(x) = x + 1 & "=" & column_id(x)
x = x + 1
Loop
x = 0
Do While x <= column_count
Loop_Input = Loop_Input & input_option(x) & vbCrLf & ""
x = x + 1
Loop
the error occurs on the set aux = Application.Workbooks.open(GetFiles)
Here is the Function GetFiles
Function GetFiles() As Variant
GetFiles = Application.GetOpenFilename(Title:="Select Files(s)", MultiSelect:=True)
End Function
I expect the function to allow me to open a workbook, then it will proceed to import the information and move forward with the code. The file selection box appears, but when I pick an excel file and hit OK, I receive the type mismatch error. Apologies for long winded text, still new to Stack Overflow. Thanks again!
I am currently writing a macro for excel and experiencing some issues using the "i = i + 1" code. I have used this elsewhere in my macro and it has worked fine, however for this section it is failing to increment correctly.
As this is quite a large piece of code, I have only included the section which is having issues, however if in order to properly debug this more code is required i am happy to provide this.
I have checked the syntax as has a colleague and we are struggling to find out where the issue is originating from, any help on this would be appreciated.
All declared variables:
D
im lastSite As Range: Set lastSite = wsReport.Range("I2:I1000")
Dim expectedSite As Range: Set expectedSite = wsReport.Range("H2:H1000")
Dim expectedLocation As Range: Set expectedLocation = wsReport.Range("G2:G1000")
Dim lostTOA As Range: Set lostTOA = wsTOAOut.Range("G2:G1000")
Dim lostMissing As Range: Set lostMissing = wsMissing.Range("G2:G1000")
siteCode = wsHome.Range("Q6")
Dim last
Dim expected
Dim lostOut
Dim lostMiss
departments = wsHome.Range("R6:R20")
Working as intended:
Dim iAllocation As Integer
For Each dept In departments
If dept = "" Then
Exit For
End If
wsLBD.Range("A" & rowCounterDepartments).Value = dept
For Each expected In expectedLocation
If expected = dept And Not expected = "" Then
iAllocation = iAllocation + 1
End If
Next
wsLBD.Range("C" & rowCounterDepartments).Value = iAllocation
iAllocation = 0
rowCounterDepartments = rowCounterDepartments + 1
Next
Not Working as intended:
rowCounterDepartments = 2
departmentsOut = wsHome.Range("R6:R20")
Dim iLoss As Integer
Dim iMissing As Integer
For Each lostOut In lostTOA
If lostOut = "" Then
Exit For
End If
For Each deptOut In departmentsOut
If lostOut = deptOut And Not lostOut = "" Then
iLoss = iLoss + 1
End If
Next
wsLBD.Range("B" & rowCounterDepartments).Value = iLoss
iLoss = 0
rowCounterDepartments = rowCounterDepartments + 1
Next
The output expected should be a total count for each department, however it is only outputting a 1 or 0 per line
This has now been resolved, i re-wrote this piece of code and it was a syntax error on my part, a couple of the pieces were the wrong way round.
I'm trying to establish a public dictionary to query at various points in the use of my document. But- the document appears to "forget" about the dictionary assigned? Is there a problem with my code?
Dim hedDict As Scripting.Dictionary
Public Function headDict()
On Error Resume Next
Dim i As Long
Dim z As Long
Dim x As Variant
Dim c As Variant
Dim d As Variant
Set hedDict = New Dictionary
z = Range("A1").End(xlToRight).Column
Sheets("New Item Entry").Select
Range("A2").Select
i = 1
Do While i <= z
c = Columns(i).Rows(1).Value
d = i
Call addToDict(hedDict, c, d)
i = i + 1
Loop
End Function
Function addToDict(dic, iteem, val)
dic.Add iteem, val
End Function
Sub ChckTst()
Dim x as Long
x = Cells(i, hedDict("Order UOM Price")).Value
MsgBox (x)
End Sub
The subroutine above does various other things before calling on the dictionary, such as calling a plethora of variables, assigning an array, and creating a collection. If that could interfere, please let me know.
Thank you