I am looking for a way to shorten my code to input data from a form of 10 entries.
This is my userform with one RMA number (applies to all 10 PN), one customer name, 10 part numbers, and 10 serial numbers that go with each part number.
This is how I want data transferred to the worksheet.
The part number textboxes are named TB#.
The serial number textboxes are named SNTB#.
This is the code I have for the first entry. I was thinking of adding code to say "TB"&"i" and "SNTB"&"i", but I don't know where to place that statement or how to start it.
Private Sub EnterButton_Click()
'this assigns receiving data to first columns of log Sheet
If TB1.Value = "" Then
Else
Worksheets("RM Tracker").Activate
Dim lastrow
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastrow = lastrow + 1
Cells(lastrow, 1) = RMATB.Value
Cells(lastrow, 2) = CustCB.Value
Cells(lastrow, 3) = TB1.Value
Cells(lastrow, 4) = SNTB1.Value
Cells(lastrow, 5) = ReceiveTB.Value
ActiveCell.Offset(1, 0).Select
End If
ActiveWorkbook.Save
Call resetform
End Sub
Sub resetform()
RMATB.Value = ""
CustCB.Value = ""
TB1.Value = ""
SNTB1.Value = ""
ReceiveTB = ""
'sets focus on that first textbox again
RecForm.RMATB.SetFocus
End Sub
You can incorporate a for loop where "i" represents the row you are working with. When you are appending data you need to put that reference within the loop so the new row is recalculated.
Private Sub EnterButton_Click()
'this assigns receiving data to first columns of log Sheet
If TB1.Value = "" Then
Else
Worksheets("RM Tracker").Activate
dim i as long
For i = 1 To 10
Dim lastrow as long ' should put a data type with dim statements
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastrow = lastrow + 1
Cells(lastrow, 1) = Userform1.Controls("RMATB" & i).Value ' change userform name to fit your need
Cells(lastrow, 2) = Userform1.Controls("CustCB" & i).Value
Cells(lastrow, 3) = Userform1.Controls("TB1" & i).Value
Cells(lastrow, 4) = Userform1.Controls("SNTB1" & i).Value
Cells(lastrow, 5) = Userform1.Controls("ReceiveTB" & i).Value
Next i
End If
ActiveWorkbook.Save
Call resetform
End Sub
Sub resetform()
RMATB.Value = ""
CustCB.Value = ""
TB1.Value = ""
SNTB1.Value = ""
ReceiveTB = ""
'sets focus on that first textbox again
RecForm.RMATB.SetFocus
Related
I created a userform to add data in excel.
The data is been added quite good but the problem is that they are added first in total row then outside the table I have created
here is the code I am using:
Sub Submit_Data()
Dim iRow As Long
If adminpanel.txtRowNumber.Value = "" Then
iRow = student.Range("A" & Rows.Count).End(xlUp).Row + 1
Else
iRow = adminpanel.txtRowNumber.Value
End If
With student.Range("A" & iRow)
.Offset(0, 0).Value = "=Row()-1"
.Offset(0, 1).Value = adminpanel.Studentname.Value
.Offset(0, 2).Value = adminpanel.Class.Value
.Offset(0, 3).Value = adminpanel.School.Value
.Offset(0, 4).Value = adminpanel.Mobile.Value
.Offset(0, 5).Value = adminpanel.Email.Value
.Offset(0, 6).Value = adminpanel.txtImagePath.Value
End With
Call Reset_Form
Application.ScreenUpdating = True
MsgBox "data are done"
End Sub
If you're working with a Table/ListObject then it has a ListRows.Add method which you should use when you need to add a new row. From that row you can get its Range property.
Sub Submit_Data()
Dim iRow As Long, tblRow As Range, lo As ListObject
Set lo = student.ListObjects(1) 'get a reference to your table
If Len(adminpanel.txtRowNumber.Value) = 0 Then
Set tblRow = lo.ListRows.Add.Range '<< add a new row and get its range
Else
'get a reference to the existing row
iRow = CLng(adminpanel.txtRowNumber.Value)
Set tblRow = Application.Intersect(student.Rows(iRow), _
lo.DataBodyRange)
End If
'Fill the row in one operation using an array
tblRow.Value = Array(tblRow.Row - 1, adminpanel.Studentname.Value, _
adminpanel.Class.Value, adminpanel.School.Value, _
adminpanel.Mobile.Value, adminpanel.Email.Value, _
adminpanel.txtImagePath.Value)
Reset_Form
MsgBox "data are done"
End Sub
I am trying to compare values in two lists. I want my code to compare a value in the first list and check all the entries in the second list. If there is a match then the code will print true next to the value in the first list and if not it will print false.
The problem I am having is that my code only compares values that are in the same row.
The code runs and I have tried it on a two smaller lists to make sure the data types are to same and there aren't any extra spaces or commas in the lists that would lead to a "False" output. I have also tried changing the order of the for and if statements but this doesn't work either.
Sub findvalues()
For i = 2 To 16
For j = 2 To 16
If Cells(i, 3).Value = Cells(i, 1).Value Then
Cells(i, 4).Value = "TRUE"
ElseIf Cells(i, 3).Value = Cells(j + 1, 1).Value Then
Cells(i, 4).Value = "TRUE"
Else
Cells(i, 4).Value = "FALSE"
End If
Next j
Next i
End Sub
Here are the two lists I am testing the code on
Slight mods to your code based on the data you provided in columns 1 & 3. As always, things could be improved but this should get you going ...
Sub findvalues()
Dim i As Long, j As Long, bResult As Boolean
For i = 2 To 16
strValueToLookFor = Cells(i, 1)
For j = 2 To 16
bResult = False
If strValueToLookFor = Cells(j, 3).Value Then
bResult = True
Exit For
End If
Next j
Cells(i, 6).Value = bResult
Next i
End Sub
... you may just need to flick the columns over so the first list searches on the second list or vice versa.
I don't see any need for VBA - formulas are the way to go - but to avoid two loops one could do this:
Sub findvalues()
Dim i As Long
For i = 2 To 130
Cells(i, 4).Value = IsNumeric(Application.Match(Cells(i, 1).Value, Range("C2:C130"), 0))
Next i
End Sub
Update: this does not cater for multiple matches.
There are many was to achieve that. one of them is by using IF & COUNTIF
Formula
=IF(COUNTIF($E$2:$E$6,A2)>0,"TRUE","FALSE")
Results:
VBA CODE
Option Explicit
Sub findvalues()
Dim i As Long
Dim rng As Range
With ThisWorkbook.Worksheets("Sheet1") 'Change if needed
Set rng = .Range("A2:A130") 'set rng to includes values from column A, rows 2:130
For i = 2 To 130 'Loop from row 2 to 130
'Check if the values in column C includes in the rng
If Application.WorksheetFunction.CountIf(rng, .Range("C" & i).Value) > 0 Then
.Range("D" & i).Value = "TRUE"
Else
.Range("D" & i).Value = "FALSE"
End If
Next i
End With
End Sub
VBA code to reconcile two lists.
Sub Reconciliation()
Dim endRow As Long
Dim ICount As Long
Dim Match1() As Variant
Dim Match2() As Variant
Dim ws As Worksheet
Set ws = Worksheets("Recon")
ICount = 0
endRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
endRow1 = ws.Cells(ws.Rows.Count, 11).End(xlUp).Row
Match1 = Sheet1.Range("b2:b" & endRow)
Match2 = Sheet1.Range("K2:K" & endRow1)
For i = LBound(Match1) To UBound(Match1)
For j = LBound(Match2) To UBound(Match2)
If Match1(i, 1) = Match2(j, 1) Then
ICount = ICount + 1
Sheet1.Range("C" & i + 1).Value = ICount
Sheet1.Range("L" & j + 1).Value = ICount
Else
End If
Next j
Next i
End Sub
I use a macro form where I write an amount that I receive every month X times
An example of how I want it to be
How can I make a macro that will continue to fill new rows with the next month, according to the times I registered
This is the code I have now, without adding more lines
Private Sub CommandButton1_Click()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("sheets")
lRow = ws.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
With ws
.Cells(lRow, 1).Value = ""
.Cells(lRow, 2).Value = Me.TextBox1.Value
.Cells(lRow, 3).Value = Me.TextBox2.Value
.Cells(lRow, 4).Value = Me.TextBox3.Value
End With
Unload Me
End Sub
(Note: This adds new rows, not at the expense of existing lines)
I will be happy for any help, idea, intention
editing:
More clarity what I want
If I write on Form No. 9 and 500$ , then will add 9 lines, with 500$ amount, but with a monthly date rising
I'm not a macro expert
e
You will want to validate the entries. What if the user puts al;kjfdadsk into any textbox? You need to make sure the inputs are in line with the expectation.
Limit the inputs like so:
Me.TextBox1 = Number
Me.TextBox2 = Date
Me.TextBox1 = Number
You can also amend this to make sure Amount is non-negative. Or maybe there is a max you want to set on Amount? Either way, it is worthwhile thinking about the limitations you want to place here and then build them in. I added the 3 limitations above in the code for you.
Private Sub CommandButton1_Click()
'Validate entries
If Not IsNumeric(Me.TextBox1) Then
MsgBox "Invalid Amount Entry"
ElseIf Not IsDate(Me.TextBox2) Then
MsgBox "Invalid Date Entry"
ElseIf Not IsNumeric(Me.TextBox3) Then
MsgBox "Invalid Payment Entry"
End If
'Rest of code goes here and will be ran once the above entries are validated
Dim ws As Worksheet, LRow as Long, i as Integer
Set ws = Worksheets("sheets")
LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0).Row
ws.Range("A" & LRow) = Me.TextBox2
ws.Range(ws.Cells(LRow, 2), ws.Cells(LRow + Me.TextBox1, 2)) = Me.TextBox3
For i = (LRow + 1) To (LRow + Me.TextBox1 - 1)
ws.Range("A" & i ) = DateAdd("m", 1, ws.Range("A" & i -1)
Next i
Unload Me
End Sub
I have problem with closing one userform and going to next. UserForm3 after clicking command button should be closed and UserForm4 should be shown. Unfortunately I get "Run time Error 91 object variable or with block variable not set". I've dug deep into internet and I am pretty sure that problem is with Userform4, although code for UserForm3 is highlighted as bugged. Basicly I want UserForm4 to be displayed and have all the textboxes filled with data from sheet "Log", based on choice from Combobox from UserForm3. Choice from UserForm3 is saved to cell E1 on "Log" Sheet.
Code from UserForm3
Private Sub CommandButton1_Click()
Sheets("Log").Range("E1") = ComboBox2.Text
Unload Me
UserForm4.Show <- ERROR DISPLAYED HERE
End Sub
In UserForm4 I want to find value from E1 in cells below and later on fill textboxes in Userform4 with data from the row, in which E1 value was found.
Code for UserForm4
Private Sub UserForm_Initialize()
Dim Name As String
Dim rng As Range
Dim LastRow As Long
Dim wart As Worksheet
wart = Sheets("Log").Range("E1")
LastRow = ws.Range("B3" & Rows.Count).End(xlUp).Row + 1
Name = Sheets("Log").Range("E1")
UserForm4.TextBox8.Text = Name
nazw = Application.WorksheetFunction.VLookup(wart, Sheets("Log").Range("B3:H" & LastRow), 1, False)
UserForm4.TextBox1.Text = ActiveCell.Offset(, 1)
UserForm4.TextBox2.Text = ActiveCell.Offset(, 1)
UserForm4.TextBox3.Text = ActiveCell.Offset(, 1)
UserForm4.TextBox4.Text = ActiveCell.Offset(, 1)
UserForm4.TextBox5.Text = ActiveCell.Offset(, 1)
UserForm4.ComboBox1.Text = ActiveCell.Offset(, 1)
UserForm4.TextBox6.Text = ActiveCell.Offset(, 1)
UserForm4.TextBox7.Text = ActiveCell.Offset(, 1)
End Sub
The code below is to avoid to run-time errors mentioned in the code above, it's not debugged for the VLookup function part.
Option Explicit
Private Sub UserForm_Initialize()
Dim Name As String
Dim LastRow As Long
Dim wart As Variant
Dim ws As Worksheet
Dim nazw As Long
' set ws to "Log" sheets
Set ws = Sheets("Log")
With ws
wart = .Range("E1")
' method 1: find last row in Column "B" , finds last row even if there empty rows in the middle
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
' method 2 to find last row, equivalent to Ctrl + Shift + Down
' LastRow = .Range("B3").CurrentRegion.Rows.Count + 1
' a little redundant with the line 2 above ?
Name = .Range("E1")
End With
With Me
.TextBox8.Text = Name
' ****** Need to use Match instead of Vlookup VLookup Section ******
If Not IsError(Application.Match(wart, ws.Range("B1:B" & LastRow - 1), 0)) Then
nazw = Application.Match(wart, ws.Range("B1:B" & LastRow - 1), 0)
Else ' wart record not found in range
MsgBox "Value in Sheet " & ws.Name & " in Range E1 not found in Column B !", vbInformation
Exit Sub
End If
.TextBox1.Text = ws.Range("B" & nazw).Offset(, 1)
.TextBox2.Text = ws.Range("B" & nazw).Offset(, 1)
.TextBox3.Text = ws.Range("B" & nazw).Offset(, 1)
.TextBox4.Text = ws.Range("B" & nazw).Offset(, 1)
.TextBox5.Text = ws.Range("B" & nazw).Offset(, 1)
.ComboBox1.Text = ws.Range("B" & nazw).Offset(, 1)
.TextBox6.Text = ws.Range("B" & nazw).Offset(, 1)
.TextBox7.Text = ws.Range("B" & nazw).Offset(, 1)
End With
End Sub
I have created this procedure which works fine for cleaning blank cells in column AF. I want to modify this to pass on the column number as a variable so i can use the same procedure for other columns.
Column Z is my temp working column.
any ideas?
Private Sub clean_com_cells()
Dim counter As Integer, i As Integer, lastrow As Integer
lastrow = Mysheet.Range("AF65536").End(xlUp).Row
counter = 0
For i = 1 To lastrow
If Mysheet.Cells(i, 32).Value <> "" Then
Mysheet.Cells(counter + 1, 26).Value = Mysheet.Cells(i, 32).Value
counter = counter + 1
End If
Next i
Mysheet.Range("AF1:AF" & lastrow).Value = ""
Mysheet.Range("AF1:AF" & lastrow).Value = Mysheet.Range("Z1:Z" & lastrow).Value
Mysheet.Range("Z1:Z" & lastrow).Value = ""
End Sub
This is not how I would have done what you're trying to do, but this allows you to parameterize the column number that you're trying to "clear". I think that it would help to explain what you're trying to accomplish more explicitly, but this code should get you what you need. Note, you need lastrow to be a Long since Integers only go from -32k to 32k (approx). FYI, Longs perform better than Integers in recent versions of VBA, since Integers get converted to Longs. Never use Integers. Bytes, on the other hand, do perform better if your data fits that profile (0 to 255).
Private Sub clean_com_cells(column_number as integer)
Dim counter As Integer, i As Integer, lastrow As long
Dim clear_rng as range
lastrow = Mysheet.cells(65536,column_number).End(xlUp).Row
counter = 0
For i = 1 To lastrow
If Mysheet.Cells(i, column_number).Value <> "" Then
Mysheet.Cells(counter + 1, 26).Value = Mysheet.Cells(i, column_number).Value
counter = counter + 1
End If
Next i
with mysheet
set clear_rng = Range(.cells(1,column_number), .cells(lastrow,column_number))
clear_rng.Value = .Range("Z1:Z" & lastrow).Value
Mysheet.Range("Z1:Z" & lastrow).Value = ""
end with
End Sub
You can adjust the function to take an input parameter, which I've named TargetColNumber below. I also added handy function for finding the last row in a worksheet... a future refactor might involve passing a Worksheet to the cleaning routine.
Anyway, call the function with a number and you should be good to...
Option Explicit
'this is the routine that cleans your cells
Sub clean_com_cells_in_col(TargetColNumber As Long)
Dim counter As Long, i As Long, lastrow As Long
Dim MySheet As Worksheet
Set MySheet = ThisWorkbook.ActiveSheet
lastrow = FindLastRow(MySheet)
counter = 0
For i = 1 To lastrow
If MySheet.Cells(i, TargetColNumber).Value <> "" Then
MySheet.Cells(counter + 1, 26).Value = MySheet.Cells(i, TargetColNumber).Value
counter = counter + 1
End If
Next i
With MySheet
.Range(.Cells(1, TargetColNumber), .Cells(lastrow, TargetColNumber)).Value = ""
.Range(.Cells(1, TargetColNumber), .Cells(lastrow, TargetColNumber)).Value = _
.Range(.Cells(1, 26), .Cells(lastrow, 26)).Value
.Range(.Cells(1, 26), .Cells(lastrow, 26)).Value = ""
End With
End Sub
'we'll use this function to identify the last row in a worksheet
Public Function FindLastRow(flrSheet As Worksheet) As Long
If Application.WorksheetFunction.CountA(flrSheet.Cells) <> 0 Then
FindLastRow = flrSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Else
FindLastRow = 1
End If
End Function
'this is our test
Sub TestItYall()
Call clean_com_cells_in_col(4) '<~ did it work?
End Sub
You can use a string variable for you column like you have done with lastrow. Example here uses a variable called "col":
Private Sub clean_com_cells()
Dim counter As Integer, i As Integer, lastrow As Integer,col as string
col = "AF" 'Change this to vary the column
lastrow = Mysheet.Range(col & "65536").End(xlUp).Row
counter = 0
For i = 1 To lastrow
If Mysheet.Cells(i, 32).Value <> "" Then
Mysheet.Cells(counter + 1, 26).Value = Mysheet.Cells(i, 32).Value
counter = counter + 1
End If
Next i
Mysheet.Range(col & "1:" & col & lastrow).Value = ""
Mysheet.Range(col & "1:" & col & lastrow).Value = Mysheet.Range("Z1:Z" & lastrow).Value
Mysheet.Range("Z1:Z" & lastrow).Value = ""
End Sub