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
Related
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
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
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
I have started learning VBA programming and thought of creating one small application for inserting student details into an Excel sheet.
In one Excel sheet named "Main", I have created a form to take user inputs and in another sheet named "Database" I am trying to insert a row of records every time a user clicks the button.
I am successfully able to insert one row of data i.e. first row of data in the database sheet, but my problem is - I want to go to the next row in the sheet once user enters the record and clicks on the button a second time. Similarly for the third time and so on.
My code is:
Private Sub CommandButton1_Click()
Dim i As String
Dim j As String
Dim k As String
Dim l as integer
i = Sheets("Main").Cells(1, 2).Value
j = Sheets("Main").Cells(2, 2).Value
k = Sheets("Main").Cells(3, 2).Value
Sheets("Main").Cells(1, 2).Value = ""
Sheets("Main").Cells(2, 2).Value = ""
Sheets("Main").Cells(3, 2).Value = ""
l=2
Sheets("Database").Cells(l, 1).Value = i
Sheets("Database").Cells(l, 2).Value = j
Sheets("Database").Cells(l, 3).Value = k
End Sub
I want to increment value of l by 1, every time user clicks on the command button so that the new record is inserted into the next row of the Database sheet.
We can get the last row of a particular column by :-
dstRw = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
Private Sub CommandButton1_Click()
Dim i As String
Dim j As String
Dim k As String
Dim m As String
i = Sheets("Main").Cells(1, 2).Value
j = Sheets("Main").Cells(2, 2).Value
k = Sheets("Main").Cells(3, 2).Value
m = Sheets("Main").Cells(4, 2).Value
Sheets("Main").Cells(1, 2).Value = ""
Sheets("Main").Cells(2, 2).Value = ""
Sheets("Main").Cells(3, 2).Value = ""
Sheets("Main").Cells(4, 2).Value = ""
dstRw = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Database").Cells(dstRw, 1).Value = i
Sheets("Database").Cells(dstRw, 2).Value = j
Sheets("Database").Cells(dstRw, 3).Value = k
Sheets("Database").Cells(dstRw, 4).Value = m
End Sub
Thanks :-
Nitish Gaurav
Quite confused about what is you want. How is the user inputting the next row? Also at the top of your code (where you assign values to i,j and k) you are iterating the row and essentially copying a column, not a row.
I'll try to answer the remainder of your question as best I can. To make VBA know how to copy data to the next row you can do this:
Sub test()
i = "John"
j = "25"
k = "Male"
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Cells(lastRow + 1, 1) = i
Cells(lastRow + 1, 2) = j
Cells(lastRow + 1, 3) = k
End Sub
Try running that a couple of times in a row and you'll see how it works. If I misunderstood please clarify what you want.
I have some VBA code that looks at the last new row for other instances of entries in Columns D and E of a row in the worksheet. When both of the column instances are found, the macro copies the data from Column F of the existing row to Column F of the new row.
However, the macro is restrictive as it ends after finding the first instance of this. I would like the macro to loop until all instances are found.
I figured the best way would be to convert the For loop into a For each loop but can't seem to make any code attempts work. Any pointers would be very helpful!
Sub test()
Dim N As Long
N = Cells(Rows.Count, "D").End(xlUp).Row
Dim i As Long
d = Cells(N, "D").Value
e = Cells(N, "E").Value
For i = N - 1 To 1 Step -1
dt = Cells(i, "D").Value
et = Cells(i, "E").Value
If d = dt And e = et Then
Cells(N, "F").Value = Cells(i, "F").Value
End If
Next i
End Sub
I see no reason to move to For Each in your case.
What you should do is read everything from your sheet into arrays at once, then loop through those arrays. It's much more efficient than looping through cells. Same goes for writing to sheet -- that's slow and inefficient. Just write the end result once, rather than repeatedly writing to the sheet.
Example:
Sub test()
Dim d, e, dt, et, ft, x
Dim i As Long
Dim N As Long
'Read everything from sheet into arrays
N = Cells(Rows.Count, "D").End(xlUp).Row
d = Cells(N, "D").Value
e = Cells(N, "E").Value
dt = Range("D1").Resize(N, 1).Value
et = Range("E1").Resize(N, 1).Value
ft = Range("F1").Resize(N, 1).Value
'Loop through arrays
For i = N - 1 To 1 Step -1
If d = dt(i, 1) And e = et(i, 1) Then
x = ft(i, 1)
End If
Next i
'Write result back to sheet
Cells(N, "F").Value = x
End Sub
Right, working from Jean-François Corbett's answer, which stores the contents in arrays before proceeding for efficiency, but adapting it to check for all duplicate rows in a progressive fashion, bottom-up. You get something like this:
Public Sub FillDuplicates()
Dim lastRow As Integer
Dim dColumn As Variant, eColumn As Variant, fColumn As Variant
Dim rowAltered() As Boolean
'Find the last row in Column D with content
lastRow = Cells(Rows.Count, "D").End(xlUp).Row
'Acquire data from columns: D, E & F in to arrays
dColumn = Range("D1").Resize(lastRow, 1).Value
eColumn = Range("E1").Resize(lastRow, 1).Value
fColumn = Range("F1").Resize(lastRow, 1).Value
ReDim rowAltered(1 To lastRow)
'Loop through all rows from bottom to top, using each D/E column value as a key
For cKeyRow = lastRow To 1 Step -1
'Ignore rows that have already been replaced
If Not rowAltered(cKeyRow) Then
'Loop through all rows above current key row looking for matches
For cSearchRow = cKeyRow To 1 Step -1
'If the row is a match and has not previously been changed, alter it
If Not rowAltered(cSearchRow) And dColumn(cKeyRow, 1) = dColumn(cSearchRow, 1) And eColumn(cKeyRow, 1) = eColumn(cSearchRow, 1) Then
fColumn(cSearchRow, 1) = fColumn(cKeyRow, 1)
rowAltered(cSearchRow) = True
End If
Next cSearchRow
End If
Next cKeyRow
'Store the amended F column back in the spreadsheet
Range("F1").Resize(lastRow, 1) = fColumn
End Sub
Note, all the work with rowAltered to determine rows that have been processed simply saves processing time. It would not be necessary, as the bottom-to-top action of the process would replace future key row values with lower duplicates as it went. Just it will do the replacements multiple times for each further duplicate up the page. The rowAltered check prevents this.
If you left the data in the spreadsheet, then you could use .Find() methods perhaps on the columns to locate duplicates, rather than the inner loop. But I doubt it would be more efficient.
I would say that
sequentially processing a list - especially with exit conditions - are better done with classical loops (Do/Loop, While, For/Next)
to use For Each ... In / Next you need to have a collection (like a range, list of sheets - anything ending on 's'), and keep in mind that it is not guaranteed that this list is processed top-down-left-right ... there is no predefined or chooseable sequence.
So according to the logic you describe I see no point changing For/Next to For Each ... In/Next.
You need to keep track of the new Row, so that each time you find a duplicate, you increase the new Row by 1. To expand on your code:
Sub test()
Dim N As Long
Dim CurRow As Long
N = Cells(Rows.Count, "D").End(xlUp).Row
CurRow = N
Dim i As Long
d = Cells(N, "D").Value
e = Cells(N, "E").Value
For i = N - 1 To 1 Step -1
dt = Cells(i, "D").Value
et = Cells(i, "E").Value
If d = dt And e = et Then
Cells(CurRow, "F").Value = Cells(i, "F").Value
CurRow = CurRow + 1
End If
Next i
End Sub