I have a userform and I want to check if a particular giftcard is present in the database or not and if found I would like to pull the values into the relevant textboxes.
I'm using the code below. This code checks for a valid gift-card (this part works).
iRow is the Last row in database
ValueToFind is the ID of gift-card
WithType is the Type of gift-card.
Code:
For i = 1 To iRow + 1
If ws.Cells(i, 2).Value = ValueToFind And _
ws.Cells(i, 1).Value = WithType And _
ws.Cells(i, 6).Value = "" Then
...
Exit Sub
End If
Next i
But I can't find a way to update the Me.TXT_MONEY.Value and Me.TXT_DATE.Value in the userform textboxes.
Can you help me with this code?
Is this what you are trying?
For i = 1 To iRow + 1
If ws.Cells(i, 2).Value = ValueToFind And _
ws.Cells(i, 1).Value = WithType And _
ws.Cells(i, 6).Value = "" Then
TXT_MONEY.Value = ws.Cells(i, X).Value
TXT_DATE.Value = ws.Cells(i, Y).Value
Exit Sub
End If
Next i
Replace X and Y in the above code with the relevant column number from where you want to pick up values.
Also instead of looping, you may actually want to use .Find? See THIS link from my blog.
Related
I am getting a "Next without For" error which I don't understand.
I have a UserForm with 2 TextBoxes and 1 ComboBox:
When I click Submit button, I want to check if the serial number matches existing data in column 4. In this case, I want the data to fill in the disposition column (3 rows to the right) with text from ComboBox1.
If it does match I want to fill a brand new row.
If no disposition is inputted, I want to exit the sub or message box. Either is ok.
I tried re-arranging If, Else, For, Next but nothing seems to work.
Private Sub SubmitButton_Click()
Dim serial_ID As String
serial_ID = Trim(SN_TextBox1.Text)
DispValue = ComboBox1.Value
Worksheets("RMA Tracker").Activate
lastrow = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To lastrow
'Searches for matching RMA & SN 'this assigns data to Log Sheet, if the data is brand new
If Worksheets("Sheet1").Cells(i, 4).Value <> serial_ID Then
ActiveSheet.Cells(i + 1, 1) = RMA_TextBox1.Value
ActiveSheet.Cells(i + 1, 4) = SN_TextBox1.Value
ActiveSheet.Cells(i + 1, 7) = ComboBox1.Value
Else
'this assigns data to disposition column to matching entries in serial number column
If Worksheets("Sheet1").Cells(i, 4).Value = serial_ID Then
ComboBox1.Text = Worksheets("Sheet1").Cells(i, 7).Value
Else
If DispValue = "" Then
Exit Sub
End If
Next i
'this clears the fields of userform when button is clicked and saves it automatically
ActiveWorkbook.Save
Call resetform
End Sub
The error message is a bit misleading. The problem are your If statements. You have three If statements, but only one End If statement. Since you also have two Else statements, I assume, you want an If / ElseIf structure. There are two ways to fix that.
Three separate IF statements (all three statements will be executed)
If Worksheets("Sheet1").Cells(i, 4).Value <> serial_ID Then
ActiveSheet.Cells(i + 1, 1) = RMA_TextBox1.Value
ActiveSheet.Cells(i + 1, 4) = SN_TextBox1.Value
ActiveSheet.Cells(i + 1, 7) = ComboBox1.Value
End if
'this assigns data to disposition column to matching entries in serial number column
If Worksheets("Sheet1").Cells(i, 4).Value = serial_ID Then
ComboBox1.Text = Worksheets("Sheet1").Cells(i, 7).Value
End if
If DispValue = "" Then
Exit Sub
End If
Alternatively, you can set up an If / ElseIf structure (if the first/second If statement is True, the subsequent If statements won't be reached and code execution will proceed after the End If statement - unless you reach Exit Sub of course) :
If Worksheets("Sheet1").Cells(i, 4).Value <> serial_ID Then
ActiveSheet.Cells(i + 1, 1) = RMA_TextBox1.Value
ActiveSheet.Cells(i + 1, 4) = SN_TextBox1.Value
ActiveSheet.Cells(i + 1, 7) = ComboBox1.Value
ElseIf Worksheets("Sheet1").Cells(i, 4).Value = serial_ID Then
ComboBox1.Text = Worksheets("Sheet1").Cells(i, 7).Value
ElseIf DispValue = "" Then
Exit Sub
End If
One of our spreadsheets requires a userform. When trying to paste the user's values to the sheet housing the data, I get error code 13: type mismatch.
All the fields are textboxes. One line of code identical except the address of where we're posting the information works.
Here's what I have:
Public Sub btnSubmit_Click()
Dim TableSht As Worksheet
Dim NextRow As Long
Set TableSht = ThisWorkbook.Sheets("Table")
TableSht.Visible = True
'https://www.mrexcel.com/forum/excel-questions/1017033-making-all-fields-userform-mandatory.html#post4880848
'determine if any fields were left blank
For Each Control In Me.Controls '
Select Case TypeName(Control)
Case "TextBox"
If Control.Value = vbNullString Then
MsgBox "empty field in " & Control.Name
Exit For
End If
Case Else
End Select
Next Control
'data is housed in E3:J3, E5:J5, E7:J7, E9:J9. if statement determines what row information
'should be entered on.
If TableSht.Range("E3") = "" Then
NextRow = 3
ElseIf TableSht.Range("E5") = "" Then
NextRow = 5
ElseIf TableSht.Range("E7") = "" Then
NextRow = 7
ElseIf TableSht.Range("E9") = "" Then
NextRow = 9
Else
MsgBox ("There are no more available rows. Contact Craig for additional assistance.")
End If
'paste the user's data entry into the appropriate cells
With TableSht
.Cells(NextRow, 5) = Me.tbOwner
.Cells(NextRow, 6) = CDate(Me.tbDate)
.Cells(NextRow, 7) = Me.tbChange
'Me.tbChange.Value = CDec(Me.tbChange) 'no longer use this but one of my attempts
.Cells(NextRow, 8) = Me.tbAmount
.Cells(NextRow, 9) = Me.tbOriginal
.Cells(NextRow, 10) = Me.tbReason
.Cells(NextRow, 7).Value = Format(Range("G" & NextRow) / 100, "0.00%")
.Cells(NextRow, 8).Value = Format(Range("H" & NextRow), "$##.##")
.Cells(NextRow, 9).Value = Format(Range("I" & NextRow) / 100, "0.00%")
End With
Sheets("Rate Calculator v8").Select
TableSht.Visible = xlVeryHidden
Unload Me
End
End Sub
The error occurs on
.Cells(NextRow, 7).Value = Format(Range("G" & NextRow) / 100, "0.00%")
There's no error if I remove the line and cycle through the two after it, even though the last line before "end with" is essentially the same statement.
I've tried swapping the two lines of code that are similar. "Cells(NextRow, 7)..." and ".Cells(NextRow, 9)..." but the error still shows up on the "Cells(NextRow, 7)..." line.
I've confirmed the cells the data is pasted in columns G and I are both formatted as "percentage".
Qualify your Range usage with a sheet. If the sheet is also TableSht, the below should work. If the Range is from a different sheet, qualify that sheet
= Format(.Range("G" & NextRow) / 100, "0.00%")
= Format(.Range("H" & NextRow), "$##.##")
= Format(.Range("I" & NextRow) / 100, "0.00%")
I have a big table in excel, which contains about 8000 rows of data. I am working on a procedure to enable the users to receive a pdf copy of what they are looking for. (A detail list related to a work order).
I tried two different approaches, first copying the work order items after filtering it to a third sheet and then copying selected fields of data to the final form. It was good and fast.
second, after filter directly copying data of unhidden rows to the final form. (also more sort and remove duplicated items happen too)
The second one is very time killing (3 to 5 minutes) and very heavy.
Now, I am thinking of first sorting the data in a way that my desired item (what the user is looking for) comes to the first of table so after the filter, I just ask the loop to go until a visible number of rows, not until the end of rows.
Has anyone any idea, or better solution?
Cheers and merry Christmas!
Sub kit_Click()
' On Error GoTo Errorhandler
Dim wc As String
Dim c As Integer
Dim tbl As Range
Dim sel As Range
Dim des As Range
Dim m As Integer
Dim j As Integer
Dim aggrow As Integer
Dim varResult As Variant
Dim kf As Worksheet
Set kf = Worksheets("Kit Form")
a = ""
' Application.ScreenUpdating = False
' finding W/B code to prepare
If Not Intersect(ActiveCell, Range("d2:d3")) Is Nothing Then
a = Cells(2, 7).Value
GoTo body
ElseIf ActiveCell.Row < 6 Then a = InputBox("please specify the W/B you want to prepare KIT form for that", "W/B Number")
ElseIf ActiveCell.Row > ActiveSheet.UsedRange.Rows.Count Then a = InputBox("please specify the W/B you want to prepare KIT form for that", "W/B Number")
Else: a = Cells(ActiveCell.Row, 2).Value
End If
body:
On Error GoTo skip
wc = WorksheetFunction.VLookup(a, Range("b5:c1000"), 2, 0)
skip:
If a = "" Or a = "0" Then
a = InputBox("please specify the W/B you want to prepare KIT form for that", "W/B Number")
Else
' Cleaning KIT FORM
If Not kf.ListObjects("KitForm").DataBodyRange Is Nothing Then kf.ListObjects("KitForm").DataBodyRange.EntireRow.Delete
' Filtering the W/B Kittable items
With Sheets("FTV3")
.Range("tbl").AutoFilter Field:=3, Criteria1:="*" & a & "*", Operator:=xlFilterValues
.Range("tbl").AutoFilter Field:=25, Criteria1:="OK", Operator:=xlFilterValues
' Unhidding the Columns and copying the header row
.Cells.EntireColumn.Hidden = False
' Copying the data to Form
lstrw = .Cells(Rows.Count, 8).End(xlUp).Row
kf.Cells(2, 2) = a
kf.Cells(1, 4) = wc
m = 1
For i = 2 To lstrw
If .Rows(i).EntireRow.Hidden Then
m = m + 1
Else
kf.Rows(i - m + 4).RowHeight = 25
kf.Cells(i - m + 4, 1).Value = i - m
If .Cells(i, 21).Value = "_N/A" Then
kf.Cells(i - m + 4, 2) = "'"
Else
kf.Cells(i - m + 4, 2) = .Cells(i, 21)
End If
kf.Cells(i - m + 4, 3).Value = .Cells(i, 4).Value
If .Cells(i, 4).Value <> "_Book" Then kf.Cells(i - m + 4, 4).Value = .Cells(i, 26).Value
Worksheets("Kit Form").Cells(i - m + 4, 5).Value = .Cells(i, 7).Value
If .Cells(i, 8).Value <> "N/T" Then kf.Cells(i - m + 4, 6).Value = .Cells(i, 8).Value
If .Cells(i, 12).Value <> "_N/A" Then ttt = .Cells(i, 12) 'Or .Cells(i, 22).Value <> ""
kf.Cells(i - m + 4, 7).Value = "(( " & .Cells(i, 27).Value & " ))" & Chr(10) & ttt
kf.Rows(i - m + 4).AutoFit
If kf.Rows(i - m + 4).RowHeight < 25 Then kf.Rows(i - m + 4).RowHeight = 25
End If
Next
.Range("A:B,S:ac").EntireColumn.Hidden = True
aggrow = kf.Cells(Rows.Count, 1).End(xlUp).Row - 4
.Range("tbl").AutoFilter
End With
Call remove_duplicate
R = MsgBox("Successfuly Total of " & lstrw - m - 1 & " Items, aggregated in " & aggrow & " Rows of material Copied to the Kit Form " & Chr(10) & Chr(10) & "Do you want an PDF version of The form being prepared for you?", vbYesNo, "Result")
If R = 6 Then Call export_pdf
End If
End Sub
Working on having a userform in Excel that will cut a row with a value in column "B" that is input on the userform, then paste the row in sheet2 while also adding 3 more values from the user form. This is what I have but currently it's doing nothing for me:
Private Sub OkButton2_Click()
Dim i As Long: i = 1
With ActiveSheet
For n = nLastRow To nFirstRow Step -1
If .Cells(n, "B") = "ChartTextBox2.Value" Then
.Cells(n, "B").EntireRow.Cut Sheet2.Cells(i, "A")
.Cells(n, "B").EntireRow.Delete
i = i + 1
'Transfer information
Sheets("Sheet2").Cells(emptyRow, 7).Value = DTPicker4.Value
Sheets("Sheet2").Cells(emptyRow, 8).Value = DispoTextBox.Value
Sheets("Sheet2").Cells(emptyRow, 9).Value = ReasonTextBox.Value
End If
Next
End With
End Sub
Below code worked fine for me. Are you comparing with text "ChartTextBox2.Value" or with the text in the textbox ChartTextBox2? Assuming you are comparing with the text in the textbox, below code works fine for me. Also in your code nLastRow and nFirstRow were not declared. If this is not the case you can remove these statements.
Private Sub OkButton2_Click()
Dim nLastRow As Long 'If already declared neglect this statement
Dim nFirstRow As Long 'If already declared neglect this statement
Dim i As Long: i = 1
nLastRow = ActiveSheet.UsedRange.Rows.Count 'If already specified neglect this statement
nFirstRow = ActiveSheet.UsedRange.Row 'If already specified neglect this statement
With ActiveSheet
For n = nLastRow To nFirstRow Step -1
If .Cells(n, "B") = ChartTextBox2.Value Then
.Cells(n, "B").EntireRow.Cut Sheets("Sheet2").Cells(i, "A")
.Cells(n, "B").EntireRow.Delete
i = i + 1
'Transfer information
Sheets("Sheet2").Cells(emptyRow, 7).Value = DTPicker4.Value
Sheets("Sheet2").Cells(emptyRow, 8).Value = DispoTextBox.Value
Sheets("Sheet2").Cells(emptyRow, 9).Value = ReasonTextBox.Value
End If
Next
End With
End Sub
I have some excel data that comes from a lab in a strange format and am trying to figure out how to put all of the patient data on the same line. An example is below, with a single entry highlighted in red so you can see that the whole thing spans 3 lines:
I think a macro would work well for something like this but recording macros is the extent of my knowledge. I do not really know how to write VBA. The goal is to get all patient information on the same row so that they can be filtered (example below):
What I have done to figure this out on my own: I began recording a macro and manually changing things (for the recording) when I realized that the references might change depending on the heading of the worksheet, which changes. I could do a relative reference macro but then pointing the cursor to the right spot for each patient over and over is almost as much work as doing it by hand. It seemed like there should be a way to say "everything contained in three lines is one 'entry', so put on one line, starting here and ending there" or something?
How's this:
Sub text()
Dim lastRow As Integer, ageCol As Integer, addressCol As Integer, i As Integer, endRow As Integer
Dim startRow As Integer, phoneCol As Integer
lastRow = ActiveSheet.UsedRange.Rows.Count
ageCol = Rows(1).Find(what:="DOB_Age").Column
addressCol = Rows(1).Find(what:="Address").Column
phoneCol = Rows(1).Find(what:="Phone").Column
'Starting off, go to first name in the list.
startRow = Cells(1, 1).End(xlDown).Row
endRow = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
For i = startRow To endRow
Cells(i, 1).Select
If Cells(i, 1).Value <> "" Then
Cells(i, ageCol).Value = Cells(i, ageCol).Value & " " & Cells(i, ageCol).Offset(1, 0).Value
Cells(i, addressCol).Value = Cells(i, addressCol).Offset(-1, 0).Value & ", " & Cells(i, addressCol).Value & ", " & Cells(i, addressCol).Offset(1, 0).Value
Cells(i, phoneCol).Value = Cells(i, phoneCol).Offset(1, 0).Value
' Now, let's clear the data we copied over.
Cells(i, ageCol).Offset(1, 0).Value = ""
Cells(i, addressCol).Offset(-1, 0).Value = ""
Cells(i, addressCol).Offset(1, 0).Value = ""
Cells(i, phoneCol).Offset(1, 0).Value = ""
End If
Next i
'Now, let's delete all the empty rows
For i = 1 To endRow
If i > endRow Then Exit For
If IsEmpty(Cells(i, 1)) Then
Cells(i, 1).EntireRow.Delete
i = i - 1
endRow = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
End If
Next i
End Sub
Note: This assumes that your data will always look like your question - the row with a name on it has ONE row above and ONE row below that need to be moved to the name's row. Please let me know what works/what doesn't work and needs tweaking. Good luck!
Multiple Formula (Non-VBA) Solution:
This option would be to get the values to appear in another sheet using formulas and autofilling down.
Note: this option assumes that all your data is as shown in the images, currently I do not account for any exceptions (which can be added)
Here are the formulas (using "Sheet1" as the reference sheet, change that to whatever your sheet name is):
(Horizontal view, ..have fun scrolling..)
A B C D E F
----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
1| Id Patient_Name Sex DOB_Age Address Phone
2| =INDIRECT("Sheet1!A"&(ROW()-1)*3) =INDIRECT("Sheet1!B"&(ROW()-1)*3) =INDIRECT("Sheet1!C"&(ROW()-1)*3) =TEXT(INDIRECT("Sheet1!D"&(ROW()-1)*3),"m/d/yyy")&", "&INDIRECT("Sheet1!D"&(ROW()-1)*3+1) =INDIRECT("Sheet1!E"&(ROW()-1)*3-1)&", "&INDIRECT("Sheet1!E"&(ROW()-1)*3)&", "&INDIRECT("Sheet1!E"&(ROW()-1)*3+1) =INDIRECT("Sheet1!F"&(ROW()-1)*3+1)
3| ..Autofill down..
(Vertical view)
Id
=INDIRECT("Sheet1!A"&(ROW()-1)*3)
Patient_Name
=INDIRECT("Sheet1!B"&(ROW()-1)*3)
Sex
=INDIRECT("Sheet1!C"&(ROW()-1)*3)
DOB_Age
=TEXT(INDIRECT("Sheet1!D"&(ROW()-1)*3),"m/d/yyy")&", "&INDIRECT("Sheet1!D"&(ROW()-1)*3+1)
Address
=INDIRECT("Sheet1!E"&(ROW()-1)*3-1)&", "&INDIRECT("Sheet1!E"&(ROW()-1)*3)&", "&INDIRECT("Sheet1!E"&(ROW()-1)*3+1)
Phone
=INDIRECT("Sheet1!F"&(ROW()-1)*3+1)
Now since these are formulas and not vba, the data will automatically change if the source changes. So if you want to only keep the values you can copy -> paste special -> values on a new sheet to keep only the values
Sub Parse_Data()
Dim rngTarget As Range, x As Long
Set rngTarget = Worksheets("Target").Range("A2")
For x = 2 To Range("E1").Offset(Rows.Count - 1).End(xlUp).Row
Select Case x Mod 3
Case 2
rngTarget.Offset(, 5).Value = Range("A1").Offset(x - 1, 4).Value
Case 0
rngTarget.Offset(, 0).Value = Range("A1").Offset(x - 1, 0).Value
rngTarget.Offset(, 1).Value = Range("A1").Offset(x - 1, 1).Value
rngTarget.Offset(, 2).Value = Range("A1").Offset(x - 1, 2).Value
rngTarget.Offset(, 3).Value = Range("A1").Offset(x - 1, 3).Value
rngTarget.Offset(, 6).Value = Range("A1").Offset(x - 1, 4).Value
Case 1
rngTarget.Offset(, 4).Value = Range("A1").Offset(x - 1, 3).Value
rngTarget.Offset(, 7).Value = Range("A1").Offset(x - 1, 4).Value
rngTarget.Offset(, 8).Value = Range("A1").Offset(x - 1, 5).Value
Set rngTarget = rngTarget.Offset(1)
End Select
Next x
End Sub