The following code works, but it only saves the last record in the loop, and I can't figure out why. I think the Submitchanges() is in the right place, at the end of the loop. Can someone please show me what's wrong? Thanks.
Sub POPULATE_CHAIN()
Dim newChain As New CHAIN
Dim dpSTRIKE As Integer
'get list of Options Contracts
Dim lstOPT = From Z In DATA.OPTIONs, X In DATA.UDLies
Where X.UDLY_SYM = Z.UDLY_SYM
Select Z.CONTRACT, Z.STRIKE_GAP, X.UDLY_LAST
Dim dctOPT = lstOPT.ToDictionary(Function(Z) Z.CONTRACT)
For Each key In dctOPT.Keys
For COUNT = 1 To 5
dpSTRIKE = 1850 + 5 * COUNT
Dim lkup = From Z In DATA.CHAINs
Select Z
Dim RCD_EXISTS As Boolean = lkup.Any(Function(Z) Z.CONTRACT = dctOPT(key).CONTRACT And Z.P_C = "C" And Z.STRIKE = dpSTRIKE)
If RCD_EXISTS = False Then
newChain.CONTRACT = dctOPT(key).CONTRACT
newChain.P_C = "C"
newChain.STRIKE = dpSTRIKE
DATA.CHAINs.InsertOnSubmit(newChain)
Else
newChain.CONTRACT = dctOPT(key).CONTRACT
newChain.P_C = "C"
newChain.STRIKE = dpSTRIKE
End If
Next
Next
DATA.SubmitChanges()
End Sub
Dim newChain As New CHAIN
should be inside Fore Each, exactly inside second for.
Since it is declared outside the loop, it will be detached from table and attached again to table. So it will be inserted only in last row.
Related
Function set_bar_positions()
bar_x(0) = delocateX(bar1.Left)
bar_y(0) = delocateY(bar1.Top)
bar_x(1) = delocateX(bar2.Left)
bar_y(1) = delocateY(bar2.Top)
bar_x(2) = delocateX(bar3.Left)
bar_y(2) = delocateY(bar3.Top)
This snippet from one of my functions show what I'm trying to do. These lines repeat almost identical until the end of the function where this is called:
bar_x(29) = delocateX(bar30.Left)
bar_y(29) = delocateY(bar30.Top)
I have tried iterating this functions by doing stuff like this, but now I know I can't:
Dim num As Integer = 0
bar_x(num) = delocateX(bar(num)).Left)
I am trying to make this code more efficient and have less lines. Anyone have an idea I can implement?
You can use Controls.Find
For i = 0 To 29
Dim cs = Me.Controls.Find("bar" & i.ToString(), True)
If cs.Any() Then
Dim c = cs.First()
bar_x(i) = delocateX(c.Left)
bar_y(i) = delocateY(c.Top)
End If
Next
so I thought this would be a simple logical problem, but for the life of me I cannot find the issue with this code block. I have checked around on Stack for a solution, but all other do/while loop problems appear to be primarily with other languages.
What I am trying to do is simply loop through an array & add a new worksheet for each element in the array that is not null. Pretty simple right? Yet for some reason it simply loops through once and thats it.
Here is the code block:
Dim repNames() As String
Dim x As Integer
x = 25
ReDim repNames(1 To x)
repNames(1) = "Ahern"
repNames(2) = "Castronovo"
repNames(3) = "Glick"
repNames(4) = "Fields"
repNames(5) = "Murphy"
repNames(6) = "Sleeter"
repNames(7) = "Vivian"
repNames(8) = "Walschot"
repNames(9) = "Wilson"
Dim i As Integer
i = 1
Do 'Loop keeps creating only 1 new sheet. Should create 9.
Worksheets.Add.Name = repNames(i)
i = i + 2
Loop While repNames(i) <> Null
I believe the problem is with this line: Loop While repNames(i) <> Null,
but obviously the logical test seems to hold up.
Any help would be hugely appreciated!
As others note, Null is not the comparison you want to make. Testing anything for equivalence with Null will return Null -- even ?Null = Null returns Null, which is why your loop is exiting early. (Note: To test for a Null, you need to use the IsNull function which returns a boolean, but that is NOT how you test for an empty string.)
In VBA, to test for a zero-length string or empty string, you can use either "" or vbNullString constant, or some people use the Len function to check for zero-length.
Rectifying that error, as originally written in your code, your logical test should abort the loop if any item is an empty string, but none of the items are empty strings (at least not in the example data you've provided) so you end up with an infinite loop which will error once i exceeds the number of items in the repNames array.
This would be probably better suited as a For Each loop.
Dim rep as Variant
For Each rep in repNames
Worksheets.Add.Name = rep
Next
If you need to skip empty values, or duplicate values, you can add that logic as needed within the loop:
For Each rep in repNames
If rep <> vbNullString 'only process non-zero-length strings
Worksheets.Add.name = rep
End If
Next
Etc.
Firstly, you should be comparing to vbNullString. This loops multiple times:
' Declare variables
Dim repNames() As String
Dim x As Integer
Dim i As Integer
' Set data
x = 25
ReDim repNames(1 To x)
repNames(1) = "Ahern"
repNames(2) = "Castronovo"
repNames(3) = "Glick"
repNames(4) = "Fields"
repNames(5) = "Murphy"
repNames(6) = "Sleeter"
repNames(7) = "Vivian"
repNames(8) = "Walschot"
repNames(9) = "Wilson"
' Loop through items
i = 1
Do
Worksheets.Add.Name = repNames(i)
i = i + 2
Loop While repNames(i) <> vbNullString
There is one more problem – why i = i + 2 ? In your question you say you wanted the loop to execute 9 times, but using i = i + 2 skips every other item. If you indeed want to loop through every item:
Do
Worksheets.Add.Name = repNames(i)
i = i + 1
Loop While repNames(i) <> vbNullString
Here you go, I have changed the loop conditional, and changed i=i+2 to i=i+1. A regular while loop would be better than a do while encase the first element is empty
Dim repNames()
Dim x As Integer
x = 25
ReDim repNames(1 To x)
repNames(1) = "Ahern"
repNames(2) = "Castronovo"
repNames(3) = "Glick"
repNames(4) = "Fields"
repNames(5) = "Murphy"
repNames(6) = "Sleeter"
repNames(7) = "Vivian"
repNames(8) = "Walschot"
repNames(9) = "Wilson"
Dim i As Integer
i = 1
Do While repNames(i) <> ""
Worksheets.Add.Name = repNames(i)
i = i + 1
Loop
My macro is to send emails for some clients. It sends the email only if there is a X at one of the lines of the column B, so then it sends the whole line to the client by creating a new sheet that goes attached to the client on the email.
The problem is that I need to create a loop to count all the columns that contain the letter X, because this macro is counting only the first line that contains the letter X and then the other ones don't go to the new sheet and consequently it doesn't go to the client. Everything is OK in my macro, despite of the counter. When i run it, just the first line that contains the X goes to the client, and the others don't. Can you guys help me?
Code:
LinhaInicio = 1
While Workbooks(planilha).Sheets("Boletas").Cells(LinhaInicio, 2) <> "X"
LinhaInicio = LinhaInicio + 1
Wend
LinhaFim = LinhaInicio
While Workbooks(planilha).Sheets("Boletas").Cells(LinhaFim, 2) = "X"
LinhaFim = LinhaFim + 1
Wend
LinhaFim = LinhaFim - 1
RangeInicio = Workbooks(planilha).Sheets("Boletas").Cells(LinhaInicio, 26).Address
RangeFim = Workbooks(planilha).Sheets("Boletas").Cells(LinhaFim, 34).Address
Set RangeCopiar = ActiveSheet.Range(RangeInicio, RangeFim)
Maybe Try something like this:
Dim vArr As Variant
Dim LinhaFim As Long
Sub mainLoop()
'put all values into variant array vArr
vArr = Workbooks(planilha).Sheets("Boletas").UsedRange
For i = LBound(vArr) To UBound(vArr)
If vArr(i, 2) = "X" Then
Nestedloops (i) 'initiate nested loops
i = LinhaFim 'artificially increment counter
End If
Next i
End Sub
Sub Nestedloops(LinhaIncio As Long)
With Workbooks(planilha).Sheets("Boletas")
LinhaFim = linhaInicio
While vArr(LinhaFim, 2) = "X"
LinhaFim = LinhaFim + 1
Wend
LinhaFim = LinhaFim - 1
RangeInicio = .Cells(LinhaInicio, 26).Address
RangeFim = .Cells(LinhaFim, 34).Address
Set RangeCopiar = ActiveSheet.Range(RangeInicio, RangeFim)
'email code goes here
End With
End Sub
Tim could come up with something better though might want to see what he comes up with
you wanna search the X letter to columns or rows, sorry I didn't understand what you try to say. You want to create a loop to count all the X letter for every row and column or only for every row from a column?
here is how you define an array:
Dim timelinessSheet, o As Variant
timelinessSheet = Worksheets("your_sheet_name").Range("A2:X" & Worksheets("your_sheet_name").Cells(Worksheets("your_sheet_name").Rows.Count, "B").End(xlUp).Row).Value
and then your code
dim i as long
for i=2 to ubound (timelinessSheet,1)
if timelinessSheet(i,2)= X then
Your_condition
end if
next I
I'm working on a bit of VBA that's intended to loop over a Schedule Builder for students made in Excel. I keep getting an Error 424 during the assignments c = c.Offset(X, 0), but only in the nested For loops. Is there a limited scope, and if so, how do I overcome it?
Below is the code:
Public Sub generateRosters()
Worksheets("Course Rosters").Cells.ClearContents
Worksheets("Course Rosters").Range("A1") = "Course"
Worksheets("Course Rosters").Range("B1") = "Room"
Dim classTitleRange As Range
Set classTitleRange = Worksheets("Master School Schedule").Range("D1:BN1")
Dim rowCount As Integer
rowCount = 2
Dim periodArr(1 To 8) As String
periodArr(1) = "A"
periodArr(2) = "B"
periodArr(3) = "C"
periodArr(4) = "D"
periodArr(5) = "E"
periodArr(6) = "F"
periodArr(7) = "G"
periodArr(8) = "Z"
For Each c In classTitleRange.Cells
Dim courseTitle As String
courseTitle = c
c = c.Offset(2, 0)
Dim room As String
room = c
For Each p In periodArr()
Dim offsetCount As Integer
offsetCount = 0
For i = 1 To 340
c = c.Offset(1, 0) '424 Error One
If c = p Then
End If
offsetCount = offsetCount + 1
Next
c = c.Offset(-offsetCount, 0) '424 Error Two
Next
Worksheets("Course Rosters").Range("A" & rowCount) = "'" & courseTitle
Worksheets("Course Rosters").Range("B" & rowCount) = room
rowCount = rowCount + 1
Next
End Sub
Thanks, for your help.
Edit: Side question, is there a way for me to create a variable that I can manipulate like c, but not be c. Basically a Dim d As (Something) followed by d = c. I can't seem to find the right object to assign to d, so that I can make it c. Thanks again.
I don't get logic and goal of your code therefore there are only some tips for you:
c=c.offset(2,0)
changes initial Range type c variable into empty or any other value.
Next you try to use, in the line with error, the same c variable as range object which is not allowed.
What you possibly need is the Set instruction in the following lines:
Set c= c.offset(2,0)
'....
Set c= c.offset(1,0)
But as I said, I don't know the complete logic therefore this is solution for the error you have but not sure if it solve all your problems.
I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.