I'm working on a loop that finds the adjacent value based on a looped additem list combobox in userform. First looped code works just perfect. second doesnt find its value.
I've tried changing formatting in the cell where the value is stored. i've tried to switch the userform box with the working one. That makes them both malfunction.
'Works without a problem
Private Sub REQUESTED_Change()
i = 1
kto = FORM.REQUESTED
Do While (Worksheets("DATA").Cells(i, 1) <> "")
i = i + 1
If Worksheets("DATA").Cells(i, 1) = kto Then
DEPARTEMENT.Text = Worksheets("DATA").Cells(i, 2)
End If
Loop
End Sub
'Doesn't work. It loops with the correct value, but doesnt find itself
Private Sub CUSTNR_Change()
i4 = 1
kSto = FORM.CUSTNR
Do While (Worksheets("DATA").Cells(i4, 6) <> "")
i4 = i4 + 1
If Worksheets("DATA").Cells(i4, 6) = kSto Then
NAZWA.Text = Worksheets("DATA").Cells(i4, 7)
End If
Loop
End Sub
It should loop based on the value typed/listed in the userform combobox, find the row its in, and based on that i value, get the adjacent value in the cell next to it in the same row.
Related
'I need this to repeat the copy and paste process across columns until counter
'= either key page, "book" cell or reads from row 1, if row 1# = key"book"#
'Next column(Page) should be 3columns from last copy/Pasted column
"PicPg" B2 copies to "PrntPg" B2
E2 to E2
etc
**This is my very first post in any forum to ask for help. Forgive the ignorance.
I'll try and answer any questions the best I can.
Thank you in advanced for your time and help!
I can share the workbook, just not sure how.
Sub createPrintPage()
With Worksheets("PicPg").Cells(2, 2)
.Copy
Sheets("PrntPg").Pictures.Paste(Link:=True).Select
With Worksheets("PrntPg").Cells(2, 5)
.Select
Worksheets("PicPg").Cells(2, 5).Copy
Sheets("PrntPg").Pictures.Paste(Link:=True).Select
End With
End With
End Sub
'the "For i", I have not figured out yet. I have been trying to get it to
'continue repeating.... I've tried to play with for i's... I get lost
'this with statement seems to be working, now to get it to continue across.
'this is day 3 ive researched, Tried many ways... and can only get this far (and this
'is much MUCH prettier(ie:Simplier) then where I began.
both method is used to loop and iterate. if you want to use For just give it a beginning and an ending
Dim i As Integer
For i = 0 To 3
'put your code in here and it will loop 4x (i = 0, i = 1, i = 2 and i = 3)
Next i
'you can put your condition for the loop to exit either at the Do or Loop by using until
i = 0
Do Until i = 3
'although start from 0, but it will loop 3x because when it hit i = 3 it will stop (i = 0, i = 1, i = 2 and i = 3)
i = i + 1 'remember to increment your counter, before leaving the loop the counter had changed to 1
Loop
i = 0
Do
'although start from 0, but it will loop 3x because when it hit i = 3 it will stop (i = 0, i = 1, i = 2 and i = 3)
i = i + 1 'remember to increment your counter
Loop Until i = 3
there is also a lot more different ways to write it.
you can use cell iteration to do your loop
Dim cell As Object 'late binding, early binding can write Dim cell as range
For Each cell In ThisWorkbook.Range("A1:A20")
'do something
Next cell
you can even use your own condition to set the stop
Do
If x = 1 Then
ThisWorkbook.Range("A1").Value = "True"
End If
Loop Until ThisWorkbook.Range("A1") = "True"
you can even Exit Do or Exit For if you have already achieved your desired outcome.
Dim i as Integer, temp as string
For i = 0 To 3
If ThisWorkbook.Range("A" & i).Value2 = "True" Then
temp = "hey, I found what I am looking for"
Exit For
End If
Next i
i have a patient list and i have used a listbox userform in order to select multiple diagnosis codes. I am only able to apply that listbox to the first cell, a2. regardless where i click in that column, i am unable to get the diganosis codes for the next patient to fall into the next row in that diganosis column. When i make a selection, they are returning back to cell a2, regardless of where i am selecting. The code i currently have is below. Can someone please help?
Private Sub CommandButton1_Click()
myVar = ""
For x = 0 To Me.LLBXMedHist.ListCount - 1
If Me.LLBXMedHist.Selected(x) Then
If myVar = "" Then
myVar = Me.LLBXMedHist.List(x, 0)
Else
myVar = myVar & "," & Me.LLBXMedHist.List(x, 0)
End If
End If
Next x
ThisWorkbook.Sheets("Sheet1").Range("a2") = myVar
End Sub
I'm brand new to VBA and am trying to understand how to add/change my code, so that the value in each cell changes as the code calculates down the 2 columns of data I have. Right now, I have the same value going down 13000 rows. This is my code:
Sub SReturn()
For Index = 1 To 13000
If Range("H3").Cells(Index, 1) = Range("H2").Cells(Index, 1) Then
Range("I3").Cells(Index, 1) = Log(Range("F3") / Range("F2"))
Else: Range("I3").Cells(Index, 1) = " "
End If
Next Index
End Sub
I have this loop to select the items in a column in a cell by cell basis, and test each against the previous. Every once in a while, maybe 2 to 4 times in 100 loops, Areas. selects two cells, and the code throws an error, type mismatch, since it cannot compare value of 2 cells. Why is this happening?
I have tried to use alternate methods to loop through the cells, and am open to suggestions, but this is the way that I have found has mostly worked since I want to loop through just visible cells.
Dim Fchours As Range
Set Fchours = ActiveSheet.Range(rng1.Address).SpecialCells _
(xlCellTypeVisible)
Do While i < 328
If ActiveSheet.FilterMode = True Then
Fchours.Areas(i + 1).Select
If ((Fchours.Areas(i + 1).Value) <> "") Then
If (Fchours.Areas(i).Value) < 5000 Then
If ((Fchours.Areas(i + 1).Value) < (Fchours.Areas(i).Value)) Then
FCcount = FCcount + 1
End If
End If
End If
End If
i = i + 1
Loop
I expect it to select individual cells at a time, and most of the time it does, just every now and again it selects 2.
I need to write a spreadsheet which when you press a button adds a row of data and asks for the parameters needed for the calculations, but I cant seem to get it to fill in the data in the next row down? I am a complete begginner to macros in excel and have only done very basic programming for matlab on my uni course.
My script so far is as follows:
Sub AddPosTol()
' AddPosTol Macro
Dim rngSeek As Range
Set rngSeek = Range("B1")
While rngSeek <> ""
'If the cell isn't empty, drop down one row:
rngSeek = rngSeek.Offset(1, 0)
End
With rngSeek.Offset(0, 1)
With .Font
.Name = "Solid Edge ANSI1 Symbols"
.Size = 11
.Value = 1
End With <--added this
End With
'don't need to call Range() around rngSeek - it is already a range type
rngSeek.Offset(0, 3) = "=RC[-1]"
rngSeek.Offset(0, 4) = "0"
With rngSeek.Offset(1, 1)
.Font.Bold = True <--don't really need a With if only one statement
End With
'can use a With statement here if you want:
With rngSeek
.Offset(1, 1) = "X value"
.Offset(2, 1) = "Y Value"
.Offset(0, 4) = "=2*SQRT((R[1]C[-3]-R[1]C)^2+(R[2]C[-3]-R[2]C)^2)"
.Offset(0, 5) = "=2*SQRT((R4C3-R[1]C)^2+(R5C3-R[2]C)^2)"
.Offset(0, 6) = "=2*SQRT((R[1]C[-3]-R[1]C)^2+(R[2]C[-3]-R[2]C)^2)"
.Offset(0, 7) = "=2*SQRT((R[1]C[-3]-R[1]C)^2+(R[2]C[-3]-R[2]C)^2)"
.Offset(0, 8) = "=2*SQRT((R4C3-R[1]C)^2+(R5C3-R[2]C)^2)"
.Offset(0, 2) = (InputBox("Insert Positional Tolerance Diametre"))
.Offset(1, 2) = (InputBox("Insert X value on drawing"))
.Offset(2, 2) = (InputBox("Insert Y value on drawing"))
End With
End Sub
OK, I'm going to refactor your code a bit to make it more readable, and try and answer your question too.
Firstly, I believe that lastrow = Worksheets("Sheet1").Rows.Count will return the number of rows in the worksheet, not the number of rows you have currently filled in. When I ran that line I got back 1048576! To find the first empty row, we need to find a column that will definitely have a value filled in for each row; then, cycle down that column looking for an empty cell: this is your first empty row:
Dim rngSeek as range
set rngSeek = Range("A1") <--your starting cell
While rngSeek <> ""
'If the cell isn't empty, drop down one row:
rngSeek = rngSeek.Offset(1, 0)
Wend
'rngSeek is now sitting at the first row that has a blank in column A
So this technique will find us the first row we are looking for. Then, we just populate that row with the data. You can leverage other elements from the code snippet above to make things easier when updating: specifically, the .offset method:
Your code:
With rngSeek.offset(0, 2)
With .Font
.Name = "Solid Edge ANSI1 Symbols"
.Size = 11
End With
.value = 1
End With
'repeat for all cells: no need to select them first, just use .offset
FYI .Offset goes like so:
Range("Cell Reference").Offset(rows, columns)
Where 'Cell Reference' can be any cell, like 'A1' or 'D24', rows is the number of rows to offset to the right (use negative number to offset to the left), and columns is the number of columns to offset down (use negative to offset up). So a value of .offset(0, 0) offsets to nowhere.
EDIT: You may not use column A to seek the first blank cell; if so, adapt the offset values to reflect which cell you want to change the value of. A value of 1 will offset one column right or one row down, and -1 will offset one column left or one row up.
ADDITION: It will be better to use Range("A1").End(xlDown) instead of the loop to find the first blank cell. Set the range variable equal to this, and replace the loop with:
set rngSeek = Range("A1").End(xlDown).Offset(1, 0)
You can then use rngSeek the way described above. (you can rename rngSeek to any variable name also).