Userform lockups using loops not working - vba

I am trying to set up my user form to do a loop or look up to reference my table which is on a sheet and is a large data base.
I want my user form to look up what I type and then auto fill in the other textboxes so that I can limit the number of duplicates and make it more stream lined.
My code is as shown below is embedded into Textbox1 and is set up to run the code after change. It is still not working and I have worked for many days and weeks trying to figure this out.
Option Explicit
Dim id As String, i As String, j As Integer, flag As Boolean
Sub GetDataA()
If Not IsNumeric(UserForm1.TextBox1.Value) Then
flag = False
i = 0
id = UserForm1.TextBox1.Value
Do While Cells(i + 1, 1).Value <> ""
If Cells(i + 1, 1).Value = id Then
flag = True
For j = 2 To 7
UserForm1.Controls("TextBox" & j).Value = Cells(i + 1, j).Value
Next j
End If
i = i + 1
Loop
If flag = False Then
For j = 5 To 10
UserForm1.Controls("TextBox" & j).Value = ""
Next j
End If
Else
End If
End Sub

you may want to adopt this refactoring of your code
Option Explicit
Sub GetDataA()
Dim j As Integer
Dim f As Range
With UserForm1 '<--| reference your userform
If Not IsNumeric(.TextBox1.Value) Then Exit Sub '<--| exit sub if its TextBox1 value is not a "numeric" one
Set f = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Find(what:=.TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole) '<--| try and find its TextBox1 value along column "A" cells from row 1 down to last not empty one
If f Is Nothing Then '<--| if not found
For j = 5 To 10
.Controls("TextBox" & j).Value = ""
Next j
Else '<--| if found
For j = 2 To 7
.Controls("TextBox" & j).Value = f.Offset(, j - 1).Value
Next j
End If
End With
End Sub
note: if this sub is actually inside UserForm1 code pane than you can change With UserForm1 to With Me

Related

My code will not work with my userform, why?

I am trying to set up a user form to do a loop and look up information in my table which is in a separate worksheet within the same workbook.
I want my user form to look up information in my table as I type and then auto fill in the other textboxes so that I can limit keystrokes and duplicates.
I found some code that worked with another user form as desired. However, when I try to use the same code for my table it goes through the loop like it’s looking but it does not populate the user form. I have tried changing with the user forms textbox names and making sure the names match... but to no avail. I also have to skip over a combo box on my user form, can this effect my code?
Option Explicit
Dim id As String, i As String, j As Integer, flag As Boolean
Sub GetData()
If Not IsNumeric(UserForm1.TextBox1.Value) Then
flag = False
i = 0
id = UserForm1.TextBox1.Value
Do While Cells(i + 1, 1).Value <> ""
If Cells(i + 1, 1).Value = id Then
flag = True
For j = 4 To 7
UserForm1.Controls("TextBox" & j).Value = Cells(i + 1, j).Value
Next j
End If
i = i + 1
Loop
If flag = False Then
For j = 2 To 4
' UserForm1.Controls("TextBox" & j).Value = ""
Next j
End If
Else
End If
End Sub
try qualifying your ranges up to worksheet reference:
Option Explicit
Sub GetDataA()
Dim id As String, i As String, j As Integer, flag As Boolean
If Not IsNumeric(UserForm1.TextBox1.Value) Then
flag = False
i = 0
id = UserForm1.TextBox1.Value
With Worksheets("myTableWorksheetName") '<--| change "myTableWorksheetName" to your actual worksheet with table name
Do While .Cells(i + 1, 1).Value <> ""
If .Cells(i + 1, 1).Value = id Then
flag = True
For j = 2 To 7
UserForm1.Controls("TextBox" & j).Value = .Cells(i + 1, j).Value
Next j
End If
i = i + 1
Loop
End With
If flag = False Then
For j = 5 To 10
UserForm1.Controls("TextBox" & j).Value = ""
Next j
End If
End If
End Sub

Loop through excel rows and call VBA functions

I need to be able to loop through my rows (specifically, column B), and use the number in a certain cell in order to do specific functions using other cells in that row. For example, Rule #1 indicates that I need to find last modified date of the path in the cell next to the Rule #, but the task is different for each Rule.
I'm new to VBA and I've just been struggling with setting up a loop and passing variables to different subs, and would hugely appreciate any help. To be clear, I'm looking for syntax help with the loop and passing variables
Thank you!
Reference Images: The spreadsheet
The attempt at sketching out the code
Private Sub CommandButton1_Click()
Dim x As Integer
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
Range("B2").Select
For x = 1 To NumRows
If Range(RowCount, 1).Value = 1 Then
RuleOne (RowCount)
End If
Next
'Dim RowCount As Integer
'RowCount = 1
'Worksheets("Sheet2").Cells(1, 2) = Worksheets("Sheet1").UsedRange.Row.Count
'While RowCount < Worksheets("Sheet1").Rows
'If Worksheets("Sheet1").Cells(RowCount, 1).Value = 1 Then
'RuleOne (RowCount)
'End If
'Wend
End Sub
Sub RuleOne(i As Integer)
'use filedatetime and path from i cell
'Worksheets("Sheet2").Cells(1, 1) = FileDateTime(C, i)
Worksheets("Sheet2").Cells(1, 1) = "hello"
End Sub
Sub RuleTwo(i As Integer)
Worksheets("Sheet2").Cells(1, 1) = "hello"
End Sub
Try to change the Range(RowCount, 1).Value = 1 to Cells(x, 2).Value = 1.
The variable RowCount has not been initialised/set.
I assume this is what this variable is meant to be the number in column B
RowCount = Cells(x, "B").Value
I also noticed that the variable NumRows seemed to be one less than it should be (so if the last row was 1 it would skip it). So I used this instead:
NumRows = Cells(Rows.Count, "B").End(xlUp).Row
So try this code:
Sub CommandButton1_Click()
Dim x As Integer
NumRows = Cells(Rows.Count, "B").End(xlUp).Row
For x = 1 To NumRows
RowCount = Range("B" & x).Value
If RowCount = 1 Then
RuleOne (x)
End If
Next
'Dim RowCount As Integer
'RowCount = 1
'Worksheets("Sheet2").Cells(1, 2) = Worksheets("Sheet1").UsedRange.Row.Count
'While RowCount < Worksheets("Sheet1").Rows
'If Worksheets("Sheet1").Cells(RowCount, 1).Value = 1 Then
'RuleOne (RowCount)
'End If
'Wend
End Sub
Sub RuleOne(i As Integer)
'use filedatetime and path from i cell
'Worksheets("Sheet2").Cells(1, 1) = FileDateTime(C, i)
Worksheets("Sheet2").Cells(1, i) = "hello"
End Sub
Sub RuleTwo(i As Integer)
Worksheets("Sheet2").Cells(1, 1) = "hello"
End Sub

'If ... Then' statement with loop

I've what seems like a pretty simple application with looping and 'If..Then' statements but need some help on structuring it.
In very a basic example, I have a list numbers in column A and the values PM or AM listed in column B. I want to write a loop that will search every value in column B until the end of the data set, and add 12 to each value in column A each time column B has a value of PM. In a nutshell, it would look like this:
If column B = PM
then add 12 to its corresponding cell in column A
else move down to the next row and do the same thing until you reach an empty cell
There are many ways, here is a typical one:
Sub dural()
Dim i As Long
i = 1
Do While Cells(i, "B").Value <> ""
If Cells(i, "B").Value = "PM" Then
Cells(i, "A").Value = Cells(i, "A").Value + 12
End If
i = i + 1
Loop
End Sub
you can set it with For next loop and 2 variables. one for last row and the 2nd for the row count:
Sub Macro1()
Dim LastRow As String
Dim i As Integer
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 2).Value = "PM" Then Cells(i, 1).vlaue = Cells(i, 1).vlaue + 10
Next i
End
'
End Sub
This is another way to do this.
Option Explicit
Sub Add()
Dim rData As Range
Dim r As Range
Set rData = Cells(1, 1).CurrentRegion.Columns("B").Cells
For Each r In rData
If UCase$(r.Value) = "PM" Then
r.Offset(, -1).Value = r.Offset(, -1).Value + 12
End If
Next r
End Sub

Error 1004 on VBA

I have five worksheet in all that are using the below code which is stored in a workbook. The first worksheet works perfectly well with the code. The second spreadsheet can check for the first item before returning the error. The subsequent third and fourth worksheet return the error immediately. The fifth worksheet on the other hand return error 400. May I know is my code the source of the problem or it's the checkbox because I copied and paste from the first worksheet.
Sub test5()
Dim MyFile As String
Dim FinalRow As Long
Dim Row As Long
Dim i As Integer
Dim d As Integer
d = 2
i = 0
FinalRow = Cells(Rows.count, "S").End(xlUp).Row
For Row = 3 To FinalRow
If Not IsEmpty(ActiveSheet.Cells(Row, "S")) Then
i = i + 1
d = d + 1
MyFile = ActiveSheet.Cells(Row, "S").Value
If Dir(MyFile) <> "" Then
ActiveSheet.OLEObjects("CheckBox" & i). _
Object.Value = True ' <~~~~~~~~~~~~~~~~ Error occurs here
With ActiveSheet.Cells(d, "F")
.Value = Now
.NumberFormat = "dd/mm/yy"
'If (ActiveSheet.Cells(d, "F") - ActiveSheet.Cells(d, "G") >= 0) Then
' ActiveSheet.Cells(d, "F").Font.Color = vbRed
'End If
If (.Value - .Offset(0, 1).Value) >= 0 Then
.Font.Color = vbRed
Else
.Font.Color = vbBlack
End If
End With
' i = i + 1
'd = d + 1
End If
End If
Next
End Sub
The program terminates after stepping into this line of code:
ActiveSheet.OLEObjects("CheckBox" & i). _ Object.Value = True
OLEObject does not have a member called value. If you are trying to display the OLEObject, use visible instead
ActiveSheet.OLEObjects("CheckBox" & i).Visible = True
See all OLEObject members here :
OLEObject Object Members

Dynamic combobox based on row from different sheet

I've got 2 sheets in my workbook in Excel 2010. The first got a row with names, listed like this:
Jens A.
Christian
Peter
Jens A.
Anders
Jens A. etc.
On the second sheet I want to make a combobox, which show all the names from the first sheet, but without duplicates. Is that possible to make in VBA code?
In addition I want to make the list dynamic, but I guess I've just have to call the function in:
Private Sub Workbook_Open()
To make that happen?
Thanx in advance
Plese check the below macro. It operates on 2 columns but you can adjust it.
Option Explicit
Sub UniqueRecords()
Dim i As Long
Dim j As Long
Dim k As Long
Dim bDuplicate As Boolean
i = 1
Do Until Cells(i, 1).Value = ""
'check if record exist
j = 1
Do Until Cells(j, 2).Value = ""
bDuplicate = False
If Cells(i, 1).Value = Cells(j, 2).Value Then
bDuplicate = True
Exit Do
End If
j = j + 1
Loop
'add record if no duplicate
If bDuplicate = False Then
For k = 1 To ActiveSheet.Rows.Count
If Cells(k, 2).Value = "" Then
Cells(k, 2).Value = Cells(i, 1).Value
Exit For
End If
Next k
End If
i = i + 1
Loop
End Sub