For i = 1 To 20
If Sheet1.Cells(i, 1) = Val(Me.TextBox13) Then
cn = cn + 1
Me("txtItem" & cn) = Sheet1.Cells(i, 2)
Me("Qty" & cn) = Sheet1.Cells(i, 3)
Me("Price" & cn) = Sheet1.Cells(i, 4)
Me("Total" & cn) = Sheet1.Cells(i, 5)
End If
Next i
This code does work properly, but I want sheet1.cells(i,3) means Quantity Column is any row is 0 then textbox result next value. All the time text box shows value without zero (0) value.
Userform Search and result
My worksheet (Sheet1)
Check if the qty column value is not 0 first and populate the controls with value if true:
For i = 1 To 20
If Sheet1.Cells(i, 1) = Val(Me.TextBox13) Then
If Sheet1.Cells(i, 3) <> 0 Then 'add in this line to check value of Qty column
cn = cn + 1
Me("txtItem" & cn) = Sheet1.Cells(i, 2)
Me("Qty" & cn) = Sheet1.Cells(i, 3)
Me("Price" & cn) = Sheet1.Cells(i, 4)
Me("Total" & cn) = Sheet1.Cells(i, 5)
End If 'add in this line
End If
Next i
Related
I have a userform that has a combo box at the top which will activate specific sheets based on the selection in the combobox. I have a search that works but it will only search and display data from sheet1 but I would like it to search and display data based on the active sheet. I have tried to update the code multiple different ways and place activesheet in place of sheet1 but it always errors out. If someone could assist with the code please let me know and I would appreciate it.
Private Sub cmdSearch_Click()
Dim totRows As Long, i As Long
totRows = Sheet1.range("A1").CurrentRegion.Rows.count
If txtname.Text = "" Then
MsgBox "Enter the name in the name block that you want to search"
End If
For i = 2 To totRows
If Trim(Sheet1.Cells(i, 1)) <> Trim(txtname.Text) And i = totRows Then
MsgBox "Name not found"
End If
If Trim(Sheet1.Cells(i, 1)) = Trim(txtname.Text) Then
txtname.Text = Sheet1.Cells(i, 1)
txtposition.Text = Sheet1.Cells(i, 2)
txtassigned.Text = Sheet1.Cells(i, 3)
cmbsection.Text = Sheet1.Cells(i, 4)
txtdate.Text = Sheet1.Cells(i, 5)
txtjoint.Text = Sheet1.Cells(i, 7)
txtDAS.Text = Sheet1.Cells(i, 8)
txtDEROS.Text = Sheet1.Cells(i, 9)
txtDOR.Text = Sheet1.Cells(i, 10)
txtTAFMSD.Text = Sheet1.Cells(i, 11)
txtDOS.Text = Sheet1.Cells(i, 12)
txtPAC.Text = Sheet1.Cells(i, 13)
ComboTSC.Text = Sheet1.Cells(i, 14)
txtTSC.Text = Sheet1.Cells(i, 15)
txtAEF.Text = Sheet1.Cells(i, 16)
txtPCC.Text = Sheet1.Cells(i, 17)
txtcourses.Text = Sheet1.Cells(i, 18)
txtseven.Text = Sheet1.Cells(i, 19)
txtcle.Text = Sheet1.Cells(i, 20)
txtnote.Text = Sheet1.Cells(i, 21)
Exit For
End If
Next i
End Sub
Combobox:
Private Sub ComboBox1_Change()
Dim actWsh As String
actWsh = ComboBox1.Text
Worksheets(actWsh).Select
End Sub
Comboboxbutton:
Private Sub CommandButton4_Click()
Me.ComboBox1.Clear
Dim strWs As String
Dim j As Integer
For j = 1 To ThisWorkbook.Sheets.count
Me.ComboBox1.AddItem Sheets(j).Name
Next
End Sub
Code that worked:
Private Sub cmdSearch_Click()
Dim wRow
If txtname.Text = "" Then
MsgBox "Enter the name in the name block that you want to search": Exit Sub
End If
With ActiveSheet
wRow = Application.Match(txtname.Text, .Columns(1), 0)
If Not IsError(wRow) Then
txtname.Text = .Cells(wRow, 1)
txtposition.Text = .Cells(wRow, 2)
txtassigned.Text = .Cells(wRow, 3)
cmbsection.Text = .Cells(wRow, 4)
txtdate.Text = .Cells(wRow, 5)
txtjoint.Text = .Cells(wRow, 7)
txtDAS.Text = .Cells(wRow, 8)
txtDEROS.Text = .Cells(wRow, 9)
txtDOR.Text = .Cells(wRow, 10)
txtTAFMSD.Text = .Cells(wRow, 11)
txtDOS.Text = .Cells(wRow, 12)
txtPAC.Text = .Cells(wRow, 13)
ComboTSC.Text = .Cells(wRow, 14)
txtTSC.Text = .Cells(wRow, 15)
txtAEF.Text = .Cells(wRow, 16)
txtPCC.Text = .Cells(wRow, 17)
txtcourses.Text = .Cells(wRow, 18)
txtseven.Text = .Cells(wRow, 19)
txtcle.Text = .Cells(wRow, 20)
txtnote.Text = .Cells(wRow, 21)
Else
MsgBox "Name not found"
End If
End With
End Sub
Step 1: On the topmost line of your code, add this line so that you may access this variable for later.
Dim actWsh As Workbook
Step 2: Replace your ComboBox1_Change() code with the one below. This will set the selected sheet to the variable actWsh
Private Sub ComboBox1_Change()
set actWsh = Worksheets(ComboBox1.Text)
actWsh.Activate
End Sub
Step 3: On your cmdSearch_Click() method, replace all Sheet1 with actWsh.
Hope this helps. :) Let me know if you have any other questions.
I am new to VBA, and I am working on a userform, which was created by someone else. The userform has four areas(Cost Code1, Cost Code 2, exc...) that input information(Cost Code, Truck Rent, Regular Hours and Overtime Hours) into specific columns on the worksheet. Right now there are text boxes at the top of the form that enters the employee name, job number and date with all of the information.
The new project has two job numbers, so instead of using the Job Number Text Box at the top, I need to add Option Buttons, or Check Boxes (whichever is easier) to choose between the two different job numbers for the four groups of information. I would like to only be allowed to select one job number per area on the userform. The job numbers will be located on a second tab called Employees in cells H1 and K1. I need the job number to be entered in column number 4. What is the code for the Check Boxes, or Option Buttons, and where would I enter it in the original code? I appreciate any help.
Private Sub cbOK_Click()
Dim NextRow As Long
'Variable for cycling through cell input
Dim i As Long
Dim Userdate As Date
i = 1
Set EESheet = ActiveWorkbook.Sheets("Employees")
Set TLISheet = ActiveWorkbook.Sheets("Worksheet")
'Activate Worksheet Tab
Sheets("Worksheet").Activate
'Set Autocalc off to speed things up.
Application.Calculation = xlCalculationManual
'Error Handling, go to bad.
On Error GoTo Bad
Userdate = tbDate.Value
'Transfer the data to the rows
For i = 1 To 6
NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
If Me.Controls("tbCC" & i & "RegHrs").Value <> "" Then
Cells(NextRow, 1) = tbDate.Value
Cells(NextRow, 2) = cmbEmployeeName.Value
Cells(NextRow, 3) = Application.WorksheetFunction.VLookup(cmbEmployeeName.Value, EESheet.Range("A:B"), 2, False)
Cells(NextRow, 4) = tbJobNumber.Value
Cells(NextRow, 5) = Me.Controls("tbJobExtra" & i).Value
Cells(NextRow, 6) = Me.Controls("cmbCC" & i).Value
Cells(NextRow, 7) = Application.WorksheetFunction.VLookup(cmbEmployeeName.Value, EESheet.Range("A:C"), 3, False)
Cells(NextRow, 8) = Application.WorksheetFunction.VLookup(cmbEmployeeName.Value, EESheet.Range("A:D"), 4, False)
Cells(NextRow, 10) = Application.WorksheetFunction.VLookup(cmbEmployeeName.Value, EESheet.Range("A:E"), 5, False)
If EEtype = 1 Then
Cells(NextRow, 9) = "SOH"
Else
Cells(NextRow, 9) = "REG"
End If
Cells(NextRow, 10) = Me.Controls("tbCC" & i & "RegHrs").Value
End If
If Me.Controls("tbCC" & i & "OTHrs").Text <> "" Then
NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Cells(NextRow, 1) = tbDate.Value
Cells(NextRow, 2) = cmbEmployeeName.Value
Cells(NextRow, 3) = Application.WorksheetFunction.VLookup(cmbEmployeeName.Value, EESheet.Range("A:B"), 2, False)
Cells(NextRow, 4) = tbJobNumber.Value
Cells(NextRow, 5) = Me.Controls("tbJobExtra" & i).Value
Cells(NextRow, 6) = Me.Controls("cmbCC" & i).Value
Cells(NextRow, 7) = Application.WorksheetFunction.VLookup(cmbEmployeeName.Value, EESheet.Range("A:C"), 3, False)
Cells(NextRow, 8) = Application.WorksheetFunction.VLookup(cmbEmployeeName.Value, EESheet.Range("A:D"), 4, False)
Cells(NextRow, 9) = "OVT"
Cells(NextRow, 10) = Me.Controls("tbCC" & i & "OTHrs").Value
End If
If i + 1 = 7 Then Exit For
If Me.Controls("cmbCC" & i + 1).Value = "" Then Exit For
Next
Bad:
If Err.Number = 1004 Then
MsgBox "This EE Does Not Exist or You Typed Their Name Incorrectly. Check the EE name spelling or enter the EE into the Employees Tab."
NextRow = Application.WorksheetFunction.CountA(Range("A:A"))
Rows(NextRow).Delete
EEpayrollentry.Hide
Sheets("Employees").Activate
End If
i = 1
For i = 1 To 6
cmbEmployeeName.Value = ""
Me.Controls("tbJobExtra" & i).Text = ""
Me.Controls("cmbCC" & i).Text = ""
Me.Controls("tbCC" & i & "RegHrs").Text = ""
Me.Controls("tbCC" & i & "OTHrs").Text = ""
Next
EEpayrollentry.lbTotalHours.Caption = 0
End Sub
I am working on a project that I am trying to keep as dynamic as I can for long-term use. I have most of the variable data in reference tables that can be easily updated as needed. The only issue I am having is that there are a couple if-then statements that could change in the future, and rather than expect future users to be able to work in VBA (if I am no longer here for some reason), I have a Statement cell where you just need to type in the criteria and my VBA code will input it into my if-then statement.
the statement cell is (i,20) and the variable is cs1 as string. I can see my text in the variable via Locals Window, so I know it is reading it. I think the issue are the "" around the text.
Is there a way to have this cell's data inputted into my if then statement? Here is a section of my code. Thanks
Dim cs1 As String
Dim cs2 As String
cn = chkdata.Cells(cm, 2) 'check number
cnm = chkdata.Cells(cm, 1) & " Check " & chkdata.Cells(cm, 2) 'check name
csrc = chkdata.Cells(cm, 7) ' Special rule yes/no
csr = Range(chkdata.Cells(cm, 8), chkdata.Cells(cm, 18)) 'check stations range
cs1 = chkdata.Cells(cm, 19) ' specific qualification statement
cs2 = chkdata.Cells(cm, 20) ' specific qualification statement2
If csrc = "No" Then
If .Cells(i, 20) = "" Then
.Cells(i, 20) = cnm
Else
.Cells(i, 20) = .Cells(i, 20) & "-" & cnm
End If
GoTo NextLoop
End If
If csrc = "Yes" Then
RONQual = .Cells(i, 17)
RODQual = .Cells(i, 18)
MXIS = TimeSerial(Hour(.Cells(i, 14)), Minute(.Cells(i, 14)), Second(.Cells(i, 14)))
MXOS = TimeSerial(Hour(.Cells(i, 15)), Minute(.Cells(i, 15)), Second(.Cells(i, 15)))
If cs1 Then
If sc2 = "" Then
If .Cells(i, 20) = "" Then
.Cells(i, 20) = cnm
Else
.Cells(i, 20) = .Cells(i, 20) & "-" & cnm
End If
GoTo NextLoop
I'm currently diving into code/VBA coding for the first time. I have a file that I dump into a worksheet that currently I'm manually organizing and pushing out. When put into the worksheet, it delimits itself across the cells. The first 2-4 cells are always parts of a name. This dump file will have varying row and column lengths every time I get it in a given day and dump into a work sheet. For example, one day it may be twenty rows and one day it may be thirty.
This is a rough illustration of what the data looks like, but my code probably doesn't match with the example below - I just wanted to provide a visual:
So, I'm wanting to make code that will start at A1 and concatenate the cells following it until it runs into a blank cell in that row. Then it places the concatenated data into cell A1 and removes the values it pulled the name pieces from and slides all the data to the left. After that, it continues the same operation on the next row until it meets the final row. As you can see in the image, I don't want any of the data after the blank cell to be affected.
This is my first time programming in general, so when you provide assistance, would you please explain your code so I can learn the concepts? Here's what I think will work so far... I'm just stuck on how to go about concatenating.
The code I currently have:
Sub DN_ERROR_ORGANIZER()
Dim row As Integer
NumRows = Range("A1", Range("A1").End(xldown)).Rows.Count
Range("A1").Select
For row = 1 To NumRows
Do Until IsEmpty(ActiveCell)
' Code to concatenate
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, 0).Select
Next
End sub
Here's another way to look at your problem: Suppose you have your table on Sheet2, and the result is reflected on Sheet1.
Sub PutInOrder()
filledcells = 0
'''lastrow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To 100
If Sheet2.Cells(i, 1) = "" Then Exit For
For a = 1 To 4
If Sheet2.Cells(i, a) = "" Then Exit For
If Sheet2.Cells(i, a) <> "" Then
filledcells = filledcells + 1
End If
Next
Select Case filledcells
Case Is = 2
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 4)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 5)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 7)
Case Is = 3
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2) + " " + Sheet2.Cells(i, 3)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 5)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 7)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 8)
Case Is = 4
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2) + " " + Sheet2.Cells(i, 3) + " " + Sheet2.Cells(i, 4)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 7)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 8)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 9)
End Select
filledcells = 0
Next
End Sub
Can you try this and let me know how you get on? It may need some tweaks depending on your precise layout. My approach is slightly different.
Sub x()
Dim n As Long, r1 As Range, r2 As Range, v
For n = 1 To Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
Set r1 = Cells(n, 1).EntireRow.SpecialCells(xlCellTypeConstants).Areas(1)
Set r2 = Cells(n, 1).EntireRow.SpecialCells(xlCellTypeConstants).Areas(2)
If Not r1 Is Nothing And Not r2 Is Nothing Then
v = Join(Application.Transpose(Application.Transpose(r1)), ", ")
Cells(n, 1) = WorksheetFunction.Proper(v)
Cells(n, 2).Resize(, r1.Count).Clear
r2.Cut Cells(n, 3)
End If
Next n
End Sub
I modified a script to cut a big chunck of data into small pieces to keep subscript in the range.
I suppose to import data into spreadsheet, but it says
Run-time error '9':
Subscript out of range
Code
Private Sub btnRefresh_Click()
Dim W As Worksheet: Set W = ActiveSheet
Dim Last As Integer: Last = W.Range("b2000").End(xlUp).Row
Dim Last1 As Integer
Dim Symbols As String
Dim i, n, x, y As Integer
Last1 = Last - CInt(Last / 10) * 9
x = 5
For n = Last1 To Last Step CInt(Last / 10)
For i = x To n
Symbols = Symbols & W.Range("b" & i).Value & "+"
Next i
x = i
'Stop
Symbols = Left(Symbols, Len(Symbols) - 1)
Debug.Print Symbols
'Stop
Dim URL As String: URL = "http://finance.yahoo.com/d/quotes.csv?s=" & Symbols & "&f=snxl1c7g0h0" & Cells(2, 11) & "j0k0va2j1e7rs7dy"
Dim Http As New WinHttpRequest
Http.Open "GET", URL, False
Http.Send
Dim Resp As String: Resp = Http.ResponseText
Dim Lines As Variant: Lines = Split(Resp, vbNewLine)
Dim sLine As String
y = 5
For i = y To n
sLine = Lines(i)
Debug.Print sLine
'Stop
If InStr(sLine, ",") > 0 Then
Values = Split(sLine, ",")
W.Cells(i, 3).Value = Split(Split(sLine, Chr(34) & "," & Chr(34))(1), Chr(34))(0)
W.Cells(i, 4).Value = Split(Split(sLine, Chr(34) & "," & Chr(34))(2), Chr(34))(0)
W.Cells(i, 5).Value = Values(UBound(Values) - 14)
W.Cells(i, 6).Value = Values(UBound(Values) - 13)
W.Cells(i, 7).Value = Values(UBound(Values) - 12)
W.Cells(i, 8).Value = Values(UBound(Values) - 11)
W.Cells(i, 9).Value = Values(UBound(Values) - 10)
W.Cells(i, 10).Value = Values(UBound(Values) - 9)
W.Cells(i, 11).Value = Values(UBound(Values) - 8)
W.Cells(i, 12).Value = Values(UBound(Values) - 7)
W.Cells(i, 13).Value = Values(UBound(Values) - 6)
W.Cells(i, 14).Value = Values(UBound(Values) - 5)
W.Cells(i, 15).Value = Values(UBound(Values) - 4)
W.Cells(i, 16).Value = Values(UBound(Values) - 3)
W.Cells(i, 17).Value = Values(UBound(Values) - 2)
W.Cells(i, 18).Value = Values(UBound(Values) - 1)
W.Cells(i, 19).Value = Values(UBound(Values))
End If
Next i
Symbols = ""
Next n
W.Cells.Columns.AutoFit
End Sub
First off, make sure you have
Option Explicit
at the top of your code so you can make sure you don't mess any of your variables up.
Subscript out of range means that the program declares (DIM) an array to be of a certain length, but tries to reference an element with a subscript greater than the actual length. Often, but not always, this happens because a loop goes one index too far. Another common cause is using an index that has never been assigned a valid value.