Set Focus to formField1 - vba

I am in need of a little help. I creater a UserForm and am attempting to get the form (on one worksheet) to write to another worksheet. I feel like I am getting close but I keep getting the following error:
I keep getting the Run-time 2110 Error in excel.
Beyond that I am trying to get the data in my userform to post to a worksheet titled Hourly CI Data.
The following code is from my UserForm object:
Private Sub cmdbtnCancel_Click()
' Clear data fields and reset the form
Me.formField1.Value = ""
Me.formField2.Value = ""
Me.formField3.Value = ""
Me.formField4.Value = ""
Me.formField5.Value = ""
Me.formField6.Value = ""
Me.formField7.Value = ""
Me.formField8.Value = ""
Me.formField9.Value = ""
Me.formField10.Value = ""
Me.formField11.Value = ""
Me.formField1.SetFocus
Unload Me
End Sub
Sub cmdbtnSave_Click()
Dim iRow As Long
Dim ws As Worksheet
Unload Me
Set ws = Worksheets("Hourly Slot CI - Data")
' Find the next empty row
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
' Input the data in the Data Table
ws.Cells(iRow, 1).Value = Me.formField1.Value
ws.Cells(iRow, 2).Value = Me.formField2.Value
ws.Cells(iRow, 3).Value = Me.formField3.Value
ws.Cells(iRow, 4).Value = Me.formField4.Value
ws.Cells(iRow, 5).Value = Me.formField5.Value
ws.Cells(iRow, 6).Value = Me.formField6.Value
ws.Cells(iRow, 7).Value = Me.formField7.Value
ws.Cells(iRow, 8).Value = Me.formField8.Value
ws.Cells(iRow, 9).Value = Me.formField9.Value
ws.Cells(iRow, 10).Value = Me.formField10.Value
ws.Cells(iRow, 11).Value = Me.formField11.Value
ws.Cells(iRow, 12).Value = Me.formField12.Value
ws.Cells(iRow, 13).Value = Me.formField13.Value
ws.Cells(iRow, 14).Value = Me.formField14.Value
ws.Cells(iRow, 15).Value = Me.formField15.Value
ws.Cells(iRow, 16).Value = Me.formField16.Value
ws.Cells(iRow, 17).Value = Me.formField17.Value
ws.Cells(iRow, 18).Value = Me.formField18.Value
ws.Cells(iRow, 19).Value = Me.formField19.Value
ws.Cells(iRow, 20).Value = Me.formField20.Value
ws.Cells(iRow, 21).Value = Me.formField21.Value
ws.Cells(iRow, 22).Value = Me.formField22.Value
ws.Cells(iRow, 23).Value = Me.formField23.Value
ws.Cells(iRow, 24).Value = Me.formField24.Value
ws.Cells(iRow, 25).Value = Me.formField25.Value
ws.Cells(iRow, 26).Value = Me.formField26.Value
ws.Cells(iRow, 27).Value = Me.formField27.Value
ws.Cells(iRow, 28).Value = Me.formField28.Value
ws.Cells(iRow, 29).Value = Me.formField29.Value
ws.Cells(iRow, 30).Value = Me.formField30.Value
ws.Cells(iRow, 31).Value = Me.formField31.Value
ws.Cells(iRow, 1).Activate
' Clear all fields and reset the form
Me.formField1.Value = ""
Me.formField2.Value = ""
Me.formField3.Value = ""
Me.formField4.Value = ""
Me.formField5.Value = ""
Me.formField6.Value = ""
Me.formField7.Value = ""
Me.formField8.Value = ""
Me.formField9.Value = ""
Me.formField10.Value = ""
Me.formField11.Value = ""
Me.formField12.Value = ""
Me.formField13.Value = ""
Me.formField14.Value = ""
Me.formField15.Value = ""
Me.formField16.Value = ""
Me.formField17.Value = ""
Me.formField18.Value = ""
Me.formField19.Value = ""
Me.formField20.Value = ""
Me.formField21.Value = ""
Me.formField22.Value = ""
Me.formField23.Value = ""
Me.formField24.Value = ""
Me.formField25.Value = ""
Me.formField26.Value = ""
Me.formField27.Value = ""
Me.formField28.Value = ""
Me.formField29.Value = ""
Me.formField30.Value = ""
Me.formField31.Value = ""
Me.formField1.SetFocus
End Sub
I am unsure on exactly how to set this focus correctly so any input is helpful. Thank you in advance!

You're unloading the form before you actually try to set the values. You need to unload the form after you're completely done with it at the very end. In your case, on the CmdbtnSave_Click sub, you'd want to put it right before End Sub, and make sure you remove it towards the beginning.
EDIT: Also, if you're unloading the form, you shouldn't need to clear out the different formfields. Unloading will remove it(and the formfield values) from the computer's memory.

Related

Formatting a line with VBA Userform

I have created a userform and I am have a small conundrum. How do I set the text to go a certain color if a value in the userform has been selected? What I am wanting to do is, if the SP.Value in the combo box is "Yes" then I want the whole iRow text to be Red, if the ST.Value is Yes I want the whole iRow to be blue. I hope this makes sense? The SP.Value and ST.Value are both combo boxes within the userform with just options of "Yes / No"
I am getting the error With Object must be user-defined type, Object or Variant
Private Sub NL_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Sp Br")
iRow = ws.Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
If SP.Value = "Yes" Then
With iRow
.colour = -16776961
.TintAndShade = 0
Sheets("Spec Break").Range("B2").Value = Customer.Value
Sheets("Spec Break").Range("B3").Value = Project.Value
Sheets("Spec Break").Range("B4").Value = Format(Now, ["DD/MM/YYYY"])
Sheets("Spec Break").Range("B5").Value = RSM.Value
ws.Cells(iRow, 1).Value = Cf.Value
ws.Cells(iRow, 2).Value = RT.Value
ws.Cells(iRow, 3).Value = MEqu.Value
ws.Cells(iRow, 4).Value = hmm.Value
ws.Cells(iRow, 5).Value = wmm.Value
ws.Cells(iRow, 6).Value = Opt.Value
ws.Cells(iRow, 7).Value = Tap.Value
ws.Cells(iRow, 8).Value = Fing.Value
ws.Cells(iRow, 9).Value = col.Value
ws.Cells(iRow, 10).Value = Pr.Value
ws.Cells(iRow, 11).Value = Qt.Value
End With
End If
'Insert a row beneath the data to push down footer image
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
'clear form values
CustRef.Value = ""
RadType.Value = ""
MysonEquiv.Value = ""
heightmm.Value = ""
widthmm.Value = ""
Output.Value = ""
Tapping.Value = ""
Fixing.Value = ""
colour.Value = ""
Price.Value = ""
Qty.Value = ""
End Sub
As SJR pointed out your iRow holds a long numerical value, 12345578 etc so you can't really do anything 'with' it (well, you could but that's beside the point). You're already there with your ws.cells code; iRow holds the row number and you specify a column. So, remove your with block and use cells and rows references for the first few lines:
If SP.Value = "Yes" Then
Rows(iRow).colour = -16776961
Rows(iRow).TintAndShade = 0
Sheets("Spec Break").Range("B2").Value = Customer.Value
Sheets("Spec Break").Range("B3").Value = Project.Value
Sheets("Spec Break").Range("B4").Value = Format(Now, ["DD/MM/YYYY"])
Sheets("Spec Break").Range("B5").Value = RSM.Value
ws.Cells(iRow, 1).Value = Cf.Value
' etc
sorry I didn't mean to click down on that... I have upped the answer. Thanks for sending me in the right direction, sadly the solution provided still yielded back an error or 2. After consulting the color pallet and MSDN I found that changing my code to the below has now worked.
Private Sub NL_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Spec Break")
iRow = ws.Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
If Specials.Value = "Yes" Then
With Rows(iRow)
.Font.Color = RGB(255, 0, 0)
Sheets("Spec Break").Range("B2").Value = Customer.Value
Sheets("Spec Break").Range("B3").Value = Project.Value
Sheets("Spec Break").Range("B4").Value = Format(Now, ["DD/MM/YYYY"])
Sheets("Spec Break").Range("B5").Value = RSM.Value
ws.Cells(iRow, 1).Value = Cf.Value
ws.Cells(iRow, 2).Value = RT.Value
ws.Cells(iRow, 3).Value = MEqu.Value
ws.Cells(iRow, 4).Value = hmm.Value
ws.Cells(iRow, 5).Value = wmm.Value
ws.Cells(iRow, 6).Value = Opt.Value
ws.Cells(iRow, 7).Value = Tap.Value
ws.Cells(iRow, 8).Value = Fix.Value
ws.Cells(iRow, 9).Value = col.Value
ws.Cells(iRow, 10).Value = Pr.Value
ws.Cells(iRow, 11).Value = Qt.Value
End With
End If
End Sub

Find Last Row In A Group Of Columns

I have a userform that enters data into columns I to S but sometimes all data points does not need to be entered. My probably is I only have the last row counting up on column I so if I have data in J through S, they would get replaced with the next set of data that has data in column I.
What I need help is coding for the last row of all columns or the next blank row of all columns. Thanks.
My code:
Private Sub cmd_EnterData_Click()
Dim iRow As Long
Dim Lastrow As Long
Dim ws As Worksheet
Set ws = Worksheets("FirstShift")
Lastrow = ws.Range("i101").End(xlUp).Row
'find first empty row in database
For iRow = 16 To Lastrow
If ws.Cells(iRow, 9) = "" And ws.Cells(iRow, 10) = "" Then
ws.Cells(iRow, 9).Value = Me.textbox_Lane1.Value
ws.Cells(iRow, 10).Value = Me.textbox_Lane2.Value
ws.Cells(iRow, 11).Value = Me.textbox_Lane3.Value
ws.Cells(iRow, 12).Value = Me.textbox_Lane4.Value
ws.Cells(iRow, 13).Value = Me.textbox_Lane5.Value
ws.Cells(iRow, 14).Value = Me.textbox_Lane6.Value
ws.Cells(iRow, 15).Value = Me.textbox_Lane7.Value
ws.Cells(iRow, 16).Value = Me.textbox_Length.Value
ws.Cells(iRow, 17).Value = Me.textbox_SheetCount.Value
ws.Cells(iRow, 18).Value = Me.cbchecktype.Value
ws.Cells(iRow, 19).Value = Me.cbchecktype1.Value
End If
Next iRow
If checkbox_Retest.Value = False And Me.textbox_Lane1.Value = "" Then
'do nothing
Me.textbox_Lane1.SetFocus
MsgBox "ENTER LANE 1 WIDTH!"
Exit Sub
End If
If checkbox_Retest.Value = False And Me.textbox_Length.Value = "" Then
'do nothing
Me.textbox_Length.SetFocus
MsgBox "ENTER YOUR LENGTH!"
Exit Sub
End If
If checkbox_Retest.Value = False And Me.textbox_SheetCount.Value = "" Then
'do nothing
Me.textbox_SheetCount.SetFocus
MsgBox "ENTER THE SHEETCOUNT!"
Exit Sub
End If
If checkbox_Retest.Value = False And Me.cbchecktype.Value = "" Then
'do nothing
Me.cbchecktype.SetFocus
MsgBox "ENTER 'PASS' OR 'FAIL' FOR PERF CHECK!!"
Exit Sub
Select Case checktype
Case Trim(Me.cbchecktype.Value) = "PASS"
checktype = "PASS"
Case Trim(Me.cbchecktype.Value) = "FAIL"
checktype = "FAIL"
End Select
End If
If checkbox_Retest.Value = False And Me.cbchecktype1.Value = "" Then
'do nothing
Me.cbchecktype1.SetFocus
MsgBox "ENTER 'PASS' OR 'FAIL' FOR SLITHER CHECK!!"
Exit Sub
Select Case checktype1
Case Trim(Me.cbchecktype1.Value) = "PASS"
checktype1 = "PASS"
Case Trim(Me.cbchecktype1.Value) = "FAIL"
checktype1 = "FAIL"
End Select
End If
With ws
.Unprotect Password:="password"
.Cells(iRow, 9).Value = Me.textbox_Lane1.Value
.Cells(iRow, 10).Value = Me.textbox_Lane2.Value
.Cells(iRow, 11).Value = Me.textbox_Lane3.Value
.Cells(iRow, 12).Value = Me.textbox_Lane4.Value
.Cells(iRow, 13).Value = Me.textbox_Lane5.Value
.Cells(iRow, 14).Value = Me.textbox_Lane6.Value
.Cells(iRow, 15).Value = Me.textbox_Lane7.Value
.Cells(iRow, 16).Value = Me.textbox_Length.Value
.Cells(iRow, 17).Value = Me.textbox_SheetCount.Value
.Cells(iRow, 18).Value = Me.cbchecktype.Value
.Cells(iRow, 19).Value = Me.cbchecktype1.Value
.Protect Password:="password"
End With
'clear the data
Me.textbox_Lane1.Value = ""
Me.textbox_Lane2.Value = ""
Me.textbox_Lane3.Value = ""
Me.textbox_Lane4.Value = ""
Me.textbox_Lane5.Value = ""
Me.textbox_Lane6.Value = ""
Me.textbox_Lane7.Value = ""
Me.textbox_Length.Value = ""
Me.textbox_SheetCount.Value = ""
Me.cbchecktype.Value = ""
Me.cbchecktype1.Value = ""
Me.checkbox_Retest.Value = False
Me.Hide
End Sub
A.S.H, I've tried your code and same thing is happening BUT I don't think its the code. Please see pictures of before and after. I think the problem is my IF STATEMENT:
"If ws.Cells (iRow, 9) = "" And ws.Cells(iRow, 10) = "" Then
As you can see, the function works fine when I have an item in columns 9 (I) and 10 (J), but when I put no data in those two columns then it gets replaced with whatever data I've entered on my userform as long as it includes data in columns 9 or 10..Thoughts on correcting this?
The following gets you the last non-empty row considering all columns:
Lastrow = ws.UsedRange.Find("*", , , , xlByRows, xlPrevious).Row
You can also restrict it to a set of columns, by replacing .UsedRange to the specific columns range, i.e. the following gets you the last non-empty row in columns G to AB:
Lastrow = ws.Range("G:AB").Find("*", , , , xlByRows, xlPrevious).Row
Add these two dim statements.
Dim ColumnCount As Integer
Dim x As Long
Change your code:
Lastrow = ws.Range("i101").End(xlUp).Row
to:
Lastrow = 0
For ColumnCount = 0 To 10
x = ws.Range("I101").Offset(0, ColumnCount).End(xlUp).Row
If x > Lastrow Then Lastrow = x
Next ColumnCount
edit:
This for loop always start on 16. Is it maybe supposed to start on Lastrow+1?
For iRow = 16 To Lastrow

VBA Excel: Dialog window opens when referring to cell in different worksheet

I'm breaking my head over this one and I hope someone can help. I have a procedure that adds a new worksheet into an Excel workbook and adds basic information of this worksheet into an overview in another worksheet (same workbook). It all works fine as it should, but unfortunately with one exception. There is one cell that should have the value of a cell in the newly created Worksheet. I've used this line for it:
c.Offset(0, 27).Value = "=" & Left(AccName.Value, 20) & "!N16"
Here the "Left(AccName.value,20)" equals the worksheet name. Unfortunately here the code opens a dialog window where I can open a file. I have no idea why and thus no idea how I can fix this. Does anybody here have any idea?
Edit: Here's the entire sub:
Sub FillBestandsübersicht()
Dim c As Range
Dim i As Integer
i = 3
'Find next empty row
Set c = Sheets("Bestandsübersicht").Range("A3")
Do Until c.Value = ""
Set c = c.Offset(1, 0)
i = i + 1
Loop
'Fill Bestandsübersicht
c.Value = AccName.Value
c.Offset(0, 1).Value = ProgRef.Value
c.Offset(0, 2).Value = QuoteNr.Value
c.Offset(0, 3).Value = PolicyNr.Value
If LdrY.Value = True Or LocY.Value = False Then c.Offset(0, 4).Value = "n.a."
c.Offset(0, 5).Value = ddUnderwriters.Value
c.Offset(0, 6).Value = IncDate.Value
c.Offset(0, 7).Value = ExpDate.Value
If LdrY.Value = True Then
c.Offset(0, 8).Value = "Lead"
Else
c.Offset(0, 8).Value = "Follow"
End If
c.Offset(0, 10).Value = PMNPL.Value
If LdrY.Value = True And LocY.Value = True Then
c.Offset(0, 11).Value = AmountLoc.Value
Else
c.Offset(0, 11).Value = 0
End If
If CoiY.Value = True Then
c.Offset(0, 12).Value = AmountCOI.Value
Else
c.Offset(0, 12).Value = 0
End If
c.Offset(0, 14).Value = "n"
c.Offset(0, 15).Value = "n"
If DocY.Value = False Then c.Offset(0, 16).Value = "x" Else c.Offset(0, 16).Value = "n"
If LdrY.Value = False Or LocY.Value = False Or CoiY.Value = False Then _
c.Offset(0, 17).Value = "x" Else c.Offset(0, 17).Value = "n"
If FacY.Value = False Then c.Offset(0, 18).Value = "x" Else c.Offset(0, 18).Value = "n"
If LdrY.Value = True Or LocY.Value = False Then c.Offset(0, 19).Value = "x" Else c.Offset(0, 19).Value = "n"
If LdrY.Value = False Or LocY.Value = False Then c.Offset(0, 20).Value = "x" Else c.Offset(0, 20).Value = "n"
c.Offset(0, 21).Value = "n"
c.Offset(0, 26).Value = Left(AccName.Value, 20)
c.Offset(0, 27).Value= "=" & Left(AccName.Value, 20) & "!N16"
'Sort Bestandsübersicht
Range("A3:AB10000").Sort key1:=Range("A3:A10000"), order1:=xlAscending, Header:=xlNo
'AutoFit rows
Sheets("Bestandsübersicht").Rows("3:" & i).EntireRow.autofit
End Sub
I think there is no sheet within your workbook which name equals to result of this function/calculation: Left(AccName.Value, 20)

input from vba form overwriting rows

I have a vba form which inputs the data gathered into one my sheets in my workbook. It is designed (supposed to be) so it will find the last empty row and then input the new information. It worked for the first 60 rows but now it keeps overwriting the existing information in row 60 and will not go further. Any ideas will help because I can't see anything that would stop it at row 60.
Sub UserForm_Initialize()
ComboBoxWellNameW1.List = Array("4-14-820", "5-56-820", "9-41-820", "10-30-820", "16-31-820", "16-12-820", "16-11-820", "10-42-820", "10-31-820", "10-32-820")
ComboBoxWellStatusW1.List = Array("Pumping", "Shut-in", "Flowing", "Work-over")
ComboBoxTagW1.List = Array("Yes", "No", "N/A")
ComboBoxStrokesW1.List = Array("3", "3.5", "4", "4.5", "5", "5.5", "6", "6.5", "7", "7.5", "8", "8.5", "9")
ComboBoxGauger.List = Array("Jim Burns", "Adam Miller")
TextBoxDate.Value = Date
ComboBoxTime.List = Array("0:00", "0:15", "0:30", "0:45", "1:00", "1:15", "1:30", "1:45", "2:00", "2:15", "2:30", "2:45", "3:00", "3:15", "3:30", "3:45", "4:00", "4:15", "4:30", "4:45", "5:00", "5:15", "5:30", "5:45", "6:00", "6:15", "6:30", "6:45", "7:00", "7:15", "7:30", "7:45", "8:00", "8:15", "8:30", "8:45", "9:00", "9:15", "9:30", "9:45", "10:00", "10:15", "10:30", "10:45", "11:00", "11:15", "11:30", "11:45", "12:00", "12:15", "12:30", "12:45", "13:00", "13:15", "13:30", "13:45", "14:00", "14:15", "14:30", "14:45", "15:00", "15:15", "15:30", "15:45", "16:00", "16:15", "16:30", "16:45", "17:00", "17:15", "17:30", "17:45", "18:00", "18:15", "18:30", "18:45", "19:00", "19:15", "19:30", "19:45", "20:00", "20:15", "20:30", "20:45", "21:00", "21:15", "21:30", "21:45", "22:00", "22:15", "22:30", "22:45", "23:00", "23:15", "23:30", "23:45")
DailyGaugeSheet.Show
End Sub
Sub commandButtonSubmit_Click()
With ThisWorkbook.Sheets("Results")
.Range("C5000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0).Select
ActiveCell.Value = TextBoxDate
ActiveCell.Offset(0, 1).Value = ComboBoxTime
ActiveCell.Offset(0, 2).Value = ComboBoxGauger
ActiveCell.Offset(0, 3).Value = ComboBoxWellNameW1
ActiveCell.Offset(0, 4).Value = ComboBoxWellStatusW1
ActiveCell.Offset(0, 5).Value = TextBoxTK1FtW1
ActiveCell.Offset(0, 6).Value = TextBoxTK1InchW1
ActiveCell.Offset(0, 7).Value = TextBoxTK2FtW1
ActiveCell.Offset(0, 8).Value = TextBoxTK2InchW1
ActiveCell.Offset(0, 9).Value = TextBoxTK3FtW1
ActiveCell.Offset(0, 10).Value = TextBoxTK3InchW1
ActiveCell.Offset(0, 11).Value = TextBoxTK4FtW1
ActiveCell.Offset(0, 12).Value = TextBoxTK4InchW1
ActiveCell.Offset(0, 13).Value = TextBoxTK5FtW1
ActiveCell.Offset(0, 14).Value = TextBoxTK5InchW1
ActiveCell.Offset(0, 15).Value = TextBoxTK1WaterHauled
ActiveCell.Offset(0, 16).Value = TextBoxTK2WaterHauled
ActiveCell.Offset(0, 17).Value = TextBoxTK3WaterHauled
ActiveCell.Offset(0, 18).Value = TextBoxTK4WaterHauled
ActiveCell.Offset(0, 19).Value = TextBoxTK5WaterHauled
ActiveCell.Offset(0, 20).Value = TextBoxTK1OilHauled
ActiveCell.Offset(0, 21).Value = TextBoxTK2OilHauled
ActiveCell.Offset(0, 22).Value = TextBoxTK3OilHauled
ActiveCell.Offset(0, 23).Value = TextBoxTK4OilHauled
ActiveCell.Offset(0, 24).Value = TextBoxTK5OilHauled
ActiveCell.Offset(0, 30).Value = TextBoxTubingW1
ActiveCell.Offset(0, 31).Value = TextBoxCasingW1
ActiveCell.Offset(0, 32).Value = ComboBoxTagW1
ActiveCell.Offset(0, 33).Value = ComboBoxStrokesW1
ActiveCell.Offset(0, 34).Value = TextBoxChokeW1
ActiveCell.Offset(0, 37).Value = TextBoxTrTempW1
ActiveCell.Offset(0, 38).Value = TextBoxTrPressW1
ActiveCell.Offset(0, 39).Value = TextBoxStaticPr
ActiveCell.Offset(0, 40).Value = TextBoxDiffPr
ActiveCell.Offset(0, 41).Value = TextBoxYestGasVol
ActiveCell.Offset(0, 42).Value = TextBoxCommentsW1
ActiveCell.Offset(0, 43).Value = TextBoxPumpIntake
ActiveCell.Offset(0, 44).Value = TextBoxPumpTemp
ActiveCell.Offset(0, 45).Value = TextBoxPumpHZ
ActiveCell.Offset(0, 46).Value = TextBoxDownTime
ActiveCell.Offset(0, 47).Value = TextBoxFluidLevel
ComboBoxTime = ""
ComboBoxWellNameW1 = ""
ComboBoxWellStatusW1 = ""
TextBoxTK1FtW1 = ""
TextBoxTK1InchW1 = ""
TextBoxTK2FtW1 = ""
TextBoxTK2InchW1 = ""
TextBoxTK3FtW1 = ""
TextBoxTK3InchW1 = ""
TextBoxTK4FtW1 = ""
TextBoxTK4InchW1 = ""
TextBoxTK5FtW1 = ""
TextBoxTK5InchW1 = ""
TextBoxTK1WaterHauled = ""
TextBoxTK2WaterHauled = ""
TextBoxTK3WaterHauled = ""
TextBoxTK4WaterHauled = ""
TextBoxTK5WaterHauled = ""
TextBoxTK1OilHauled = ""
TextBoxTK2OilHauled = ""
TextBoxTK3OilHauled = ""
TextBoxTK4OilHauled = ""
TextBoxTK5OilHauled = ""
TextBoxTubingW1 = ""
TextBoxCasingW1 = ""
ComboBoxTagW1 = ""
ComboBoxStrokesW1 = ""
TextBoxChokeW1 = ""
TextBoxTrTempW1 = ""
TextBoxTrPressW1 = ""
TextBoxStaticPr = ""
TextBoxDiffPr = ""
TextBoxYestGasVol = ""
TextBoxCommentsW1 = ""
TextBoxPumpIntake = ""
TextBoxPumpTemp = ""
TextBoxPumpHZ = ""
TextBoxDownTime = ""
TextBoxFluidLevel = ""
End With
End Sub
Replace
.Range("C5000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0).Select
with
Y = ActiveSheet.UsedRange.Rows.Count
lastRow = ActiveCell.SpecialCells(xlLastCell).Row
.Cells(lastRow, "C").Select
Try changing this:
.Range("C5000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0).Select
To just this:
.Range("C" & .Rows.Count).End(xlUp).Offset(1,0).Select
The Offset(1,0) is absolutely necessary to get the next empty row. Otherwise, you are just targeting your last row again and again.
Also, quit using ActiveCell and Select. They're honestly crappy methods. Check this post for some ideas: Can I make this macro more efficient or faster? Check #4. It should give you an idea on how to tackle this better.
Let us know if this helps.

Excel Macro to Insert Data into Next Row

I can't seem to figure out how to offset the information into the next row down.
What I'm trying to do is insert the same information on the next row down every time this macro is executed. I'm using it as a cheap for of Learning Management System to track completion of eLearning courses, so every time a user executes the macro it will list the date, course, and their username.
The information in .Cells(1, 1) is incorrect, but I just used that to ensure the rest of the macro was working. At this point I just need to figure out how build in the logic to move down one row each time the macro is executed.
Thanks in advance for your help!
Sub Test()
Dim objNetwork
Set objNetwork = CreateObject("WScript.Network")
strUserName = objNetwork.UserName
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("G:\Training\GPL\Test.xlsx")
objExcel.Application.DisplayAlerts = False
objExcel.Application.Visible = False
objWorkbook.Worksheets(1).Activate
objWorkbook.Worksheets(1).Cells(1, 1).Value = "GPL Overview"
objWorkbook.Worksheets(1).Cells(1, 2).Value = strUserName
objWorkbook.Worksheets(1).Cells(1, 3).Value = Date
'objExcel.ActiveWorkbook.Save "G:\Training\GPL\Test.xlsx"
objExcel.ActiveWorkbook.SaveAs "G:\Training\GPL\Test.xlsx"
objExcel.ActiveWorkbook.Close
'objExcel.ActiveWorkbook.
'objExcel.Application.Quit
'WScript.Echo "Finished."
'WScript.Quit
objExcel.Application.Quit
End Sub
This should fix it for you. Add this right after objWorkbook.Worksheets(1).Activate
Dim lastrow as Long
lastrow = objExcel.Worksheets(1).Range("A" & objExcel.Worksheets(1).Rows.Count).End(xlup).Row + 1
And change the next three lines to this:
objWorkbook.Worksheets(1).Cells(lastrow, 1).Value = "GPL Overview"
objWorkbook.Worksheets(1).Cells(lastrow, 2).Value = strUserName
objWorkbook.Worksheets(1).Cells(lastrow, 3).Value = Date
Update
Since it looks like you are running this code inside Excel itself, I am going to show you how you can really clean this code up and allow it to run faster and be easier to decipher. See the code below:
Option Explicit
Sub Test()
Dim strUserName as String
strUserName = ENVIRON("username")
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Dim objWorkbook as Workbook
Set objWorkbook = Workbooks.Open("G:\Training\GPL\Test.xlsx")
Dim wks as Worksheet
Set wks = objWorkbook.Sheets(1)
With wks
Dim lastrow as Long
lastrow = .Range("A" & .Rows.Count).End(xlup).Row + 1
.Cells(lastrow, 1).Value = "GPL Overview"
.Cells(lastrow, 2).Value = strUserName
.Cells(lastrow, 3).Value = Date
End WIth
objWorkbook.Close True
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Thanks Scott Holtzman
I had a similar problem although i had to change some settings but after few long days you came to my rescue. Thanks indeed for help.
Here is a code i implemented and your reply helped me.
Private Sub Btn_Save_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Btn_Save.Click
Dim MyExcel As Microsoft.Office.Interop.Excel.Application
MyExcel = New Microsoft.Office.Interop.Excel.Application
Dim wb As Microsoft.Office.Interop.Excel.Workbook
wb = MyExcel.Workbooks.Open("C:\Users\IMTIYAZ\Desktop\try")
Dim ws As Microsoft.Office.Interop.Excel.Worksheet
ws = wb.Sheets("sheet1")
With ws
Dim irow As Long
irow = ws.Range("A65536").End(Excel.XlDirection.xlUp).Offset(1, 0).Select
irow = ws.Range("A" & ws.Rows.Count).End(Excel.XlDirection.xlUp).Row + 1
ws.Cells(irow, 1).Value = Me.txtSn.Text
ws.Cells(irow, 2).Value = Me.txtNa.Text
ws.Cells(irow, 3).Value = Me.txtGpf.Text
ws.Cells(irow, 4).Value = Me.txtBa.Text
ws.Cells(irow, 5).Value = Me.txtBn.Text
ws.Cells(irow, 6).Value = Me.txtAp.Text
ws.Cells(irow, 7).Value = Me.txtBp.Text
ws.Cells(irow, 8).Value = Me.txtGp.Text
ws.Range(irow, 9).Formula = ("=$G$3+$H$3")
Me.Lbl_Tt.Text = ws.Cells(irow, 9).Value
ws.Cells(irow, 10).Value = Me.txtPp.Text
ws.Cells(irow, 11).Value = Me.txtDa.Text
ws.Cells(irow, 12).Value = Me.txtMa.Text
ws.Cells(irow, 13).Value = Me.txtRa.Text
ws.Cells(irow, 14).Value = Me.txtCa.Text
ws.Cells(irow, 15).Value = Me.txtOa.Text
ws.Cells(irow, 16).Formula = ("=i3+J3+K3+L3+M3+N3+O3")
Me.Lbl_Gt.Text = ws.Cells(irow, 16).Value
ws.Cells(irow, 17).Value = Me.txtFa.Text
ws.Cells(irow, 18).Formula = ("=P3-Q3")
Me.Lbl_Naf.Text = ws.Cells(irow, 18).Value
ws.Cells(irow, 19).Value = Me.txtSf.Text
ws.Cells(irow, 20).Value = Me.txtRf.Text
ws.Cells(irow, 21).Value = Me.txtSi1.Text
ws.Cells(irow, 22).Value = Me.txtSi2.Text
ws.Cells(irow, 23).Value = Me.txtSi3.Text
ws.Cells(irow, 24) = ("=S3+T3+V3+W3+U3")
Me.Lbl_Td.Text = ws.Cells(irow, 24).Value
ws.Cells(irow, 25).Formula = ("=R3-X3")
Me.Lbl_Nad.Text = ws.Cells(irow, 25).Value
ws.Cells(irow, 26).Value = Me.txtHl.Text
ws.Cells(irow, 27).Value = Me.txtCsc.Text
ws.Cells(irow, 28).Value = Me.txtMr.Text
ws.Cells(irow, 29).Value = Me.txtIt.Text
ws.Cells(irow, 30).Formula = ("=Y3-(AC3+Z3+AA3+AB3)")
Me.Lbl_Np.Text = ws.Cells(irow, 30).Value
MessageBox.Show("The last row in Col A of Sheet1 which has data is " & irow)
End With
MyExcel.Quit()
MyExcel = Nothing
Me.Update()
End Sub
End Class