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.
Related
I am new to VBA and I have a question. I have created a userform in excel. So, my question is that I want to enter values in the textbox and submit, the next time I launch the userform, it remembers the last entry in the userform. So, for example, I have textbox called facility. I enter in value UHN for the first time. Once I have closed the userform. Then I open the userform again, the value UHN is already filled in so the user does not need to type it again. So, the user form remembers the last entry in the textbox.
Thank you in advance!
My vba code is as follows:
Option Explicit
Private Sub AddlistButton_Click()
Dim emptyRow As Long
wsmenu.Activate
emptyRow = WorksheetFunction.CountA(Range("A:A"))
Me.Hide
wsfilms.Select
'Range("a1").End(xlDown).Offset(1, 0).Select
Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
'Add facility name
ActiveCell.Value = FacilityBox
'Add service area
ActiveCell.Offset(0, 1).Value = ServiceAreaBox
'Add date
ActiveCell.Offset(0, 2).Value = DateBox
'Add time
ActiveCell.Offset(0, 3).Value = TimeBox.Value
'Add room
ActiveCell.Offset(0, 4).Value = RoomBox.Value
'Briefing Question 1
If Yes1.Value = True Then
ActiveCell.Offset(0, 5).Value = "Yes"
Else
ActiveCell.Offset(0, 5).Value = "No"
End If
'Timeout Question 1
If Yes2.Value = True Then
ActiveCell.Offset(0, 6).Value = "Yes"
Else
ActiveCell.Offset(0, 6).Value = "No"
End If
If Yes3.Value = True Then
'Debriefing Question 1
ActiveCell.Offset(0, 7).Value = "Yes"
Else
ActiveCell.Offset(0, 7).Value = "No"
End If
'Comment 1
ActiveCell.Offset(0, 8).Value = Comment1.Value
'Briefing Question 2
If Yes4.Value = True Then
ActiveCell.Offset(0, 9).Value = "Yes"
Else
ActiveCell.Offset(0, 9).Value = "No"
End If
'Timeout Question 2
If Yes5.Value = True Then
ActiveCell.Offset(0, 10).Value = "Yes"
Else
ActiveCell.Offset(0, 10).Value = "No"
End If
'Debriefing Question 2
If Yes6.Value = True Then
ActiveCell.Offset(0, 11).Value = "Yes"
Else
ActiveCell.Offset(0, 11).Value = "No"
End If
'Comment 2
ActiveCell.Offset(0, 12).Value = Comment2.Value
'Briefing Question 3
If Yes7.Value = True Then
ActiveCell.Offset(0, 13).Value = "Yes"
Else
ActiveCell.Offset(0, 13).Value = "No"
End If
'Timeout Question 3
If Yes8.Value = True Then
ActiveCell.Offset(0, 14).Value = "Yes"
Else
ActiveCell.Offset(0, 14).Value = "No"
End If
'Debriefing Question 3
If Yes9.Value = True Then
ActiveCell.Offset(0, 15).Value = "Yes"
Else
ActiveCell.Offset(0, 15).Value = "No"
End If
'Comment 3
ActiveCell.Offset(0, 16).Value = Comment3.Value
'Briefing Question 4
If Yes10.Value = True Then
ActiveCell.Offset(0, 17).Value = "Yes"
Else
ActiveCell.Offset(0, 17).Value = "No"
End If
'Timeout Question 4
If Yes11.Value = True Then
ActiveCell.Offset(0, 18).Value = "Yes"
Else
ActiveCell.Offset(0, 18).Value = "No"
End If
'Debriefing Question 4
If Yes12.Value = True Then
ActiveCell.Offset(0, 19).Value = "Yes"
Else
ActiveCell.Offset(0, 19).Value = "No"
End If
'Comment 4
ActiveCell.Offset(0, 20).Value = Comment4.Value
'Briefing Question 5
If Yes13.Value = True Then
ActiveCell.Offset(0, 21).Value = "Yes"
Else
ActiveCell.Offset(0, 21).Value = "No"
End If
'Timeout Question 5
If Yes14.Value = True Then
ActiveCell.Offset(0, 22).Value = "Yes"
Else
ActiveCell.Offset(0, 22).Value = "No"
End If
'Debriefing Question 5
If Yes15.Value = True Then
ActiveCell.Offset(0, 23).Value = "Yes"
Else
ActiveCell.Offset(0, 23).Value = "No"
End If
'Comment 5
ActiveCell.Offset(0, 24).Value = Comment5.Value
'Briefing Question 6
If Yes16.Value = True Then
ActiveCell.Offset(0, 25).Value = "Yes"
Else
ActiveCell.Offset(0, 25).Value = "No"
End If
'Timeout Question 6
If Yes17.Value = True Then
ActiveCell.Offset(0, 26).Value = "Yes"
Else
ActiveCell.Offset(0, 26).Value = "No"
End If
'Debriefing Question 6
If Yes18.Value = True Then
ActiveCell.Offset(0, 27).Value = "Yes"
Else
ActiveCell.Offset(0, 27).Value = "No"
End If
'Comment 6
ActiveCell.Offset(0, 28).Value = Comment6.Value
'Briefing Question 7
If Yes19.Value = True Then
ActiveCell.Offset(0, 29).Value = "Yes"
Else
ActiveCell.Offset(0, 29).Value = "No"
End If
'Timeout Question 7
If Yes20.Value = True Then
ActiveCell.Offset(0, 30).Value = "Yes"
Else
ActiveCell.Offset(0, 30).Value = "No"
End If
'Debriefing Question 7
If Yes21.Value = True Then
ActiveCell.Offset(0, 31).Value = "Yes"
Else
ActiveCell.Offset(0, 31).Value = "No"
End If
'Comment 7
ActiveCell.Offset(0, 32).Value = Comment7.Value
'Additional Question 8
If Yes22.Value = True Then
ActiveCell.Offset(0, 33).Value = "Yes"
Else
ActiveCell.Offset(0, 33).Value = "No"
End If
'Comment 8
ActiveCell.Offset(0, 34).Value = comment8.Value
'Completed by
ActiveCell.Offset(0, 35).Value = comment9.Value
MsgBox " Data was successfully added to row " & ActiveCell.Row
Unload Me
End Sub
Private Sub CancelButton_Click()
Me.Hide
'Unload FilmDetails
Unload Me
End Sub
Private Sub OptionButton1_Click()
End Sub
Private Sub UserForm_Initialize()
TimeBox.Text = Format(Time, "hh:mm AM/PM")
DateBox.Text = Format(Date, "dd mmm yyyy")
With ServiceAreaBox
.AddItem "Anaesthesiology"
.AddItem "Cardiac"
.AddItem "Endoscopy"
.AddItem "General"
.AddItem "Gynaecologic"
.AddItem "Neurosurgery"
.AddItem "Obstetrics"
.AddItem "Oncology"
.AddItem "Ophthalmic"
.AddItem "Oral and Maxillofacial and Dentistry"
.AddItem "Orthopaedic"
.AddItem "Otolaryngic (ENT)"
.AddItem "Plastic and Reconstructive"
.AddItem "Thoracic"
.AddItem "Transplant"
.AddItem "Urologic"
.AddItem "Vascular"
.AddItem "All Other "
End With
End Sub
Private Sub UserForm_Terminate()
wsmenu.Select
End Sub
Private Sub Yes1_Click()
End Sub
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
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.
The first section is where I am copying the data from and the second section is where I am pasting the data to. Multiple worksheets will be added to the workbook ( tech collect) so when i run the code it should copy all info from "tech collect" to "tech database"
Sub Test()
'
' Test Macro
' test
'
' Keyboard Shortcut: Ctrl+a
'
Sheets("Technician Collection").Select
Range("B3").Select
Sheets("Tech Collection Database").Select
Range("B6").Select
Sheets("Technician Collection").Select
xb3 = (ActiveCell.Value)
xb4 = (ActiveCell.Offset(1, 0).Value)
xb5 = (ActiveCell.Offset(2, 0).Value)
xb6 = (ActiveCell.Offset(3, 0).Value)
xb7 = (ActiveCell.Offset(4, 0).Value)
xb8 = (ActiveCell.Offset(5, 0).Value)
xb9 = (ActiveCell.Offset(6, 0).Value)
xb10 = (ActiveCell.Offset(7, 0).Value)
xb11 = (ActiveCell.Offset(8, 0).Value)
xb12 = (ActiveCell.Offset(9, 0).Value)
xb15 = (ActiveCell.Offset(12, 0).Value)
xb16 = (ActiveCell.Offset(13, 0).Value)
xb17 = (ActiveCell.Offset(14, 0).Value)
xb18 = (ActiveCell.Offset(15, 0).Value)
xb19 = (ActiveCell.Offset(16, 0).Value)
xb20 = (ActiveCell.Offset(17, 0).Value)
xb21 = (ActiveCell.Offset(18, 0).Value)
xb22 = (ActiveCell.Offset(19, 0).Value)
xb24 = (ActiveCell.Offset(21, 0).Value)
xc24 = (ActiveCell.Offset(21, 1).Value)
xd24 = (ActiveCell.Offset(21, 2).Value)
xe24 = (ActiveCell.Offset(21, 3).Value)
xb25 = (ActiveCell.Offset(22, 0).Value)
xb26 = (ActiveCell.Offset(23, 0).Value)
xc26 = (ActiveCell.Offset(23, 1).Value)
xd26 = (ActiveCell.Offset(23, 2).Value)
xe26 = (ActiveCell.Offset(23, 3).Value)
xb27 = (ActiveCell.Offset(24, 0).Value)
xc27 = (ActiveCell.Offset(24, 1).Value)
xd27 = (ActiveCell.Offset(24, 2).Value)
xe27 = (ActiveCell.Offset(24, 3).Value)
xb28 = (ActiveCell.Offset(25, 0).Value)
xc28 = (ActiveCell.Offset(25, 1).Value)
xd28 = (ActiveCell.Offset(25, 2).Value)
xe28 = (ActiveCell.Offset(25, 3).Value)
xb30 = (ActiveCell.Offset(27, 0).Value)
xc30 = (ActiveCell.Offset(27, 1).Value)
xd30 = (ActiveCell.Offset(27, 2).Value)
xe30 = (ActiveCell.Offset(27, 3).Value)
xb32 = (ActiveCell.Offset(29, 0).Value)
xb34 = (ActiveCell.Offset(31, 0).Value)
xb36 = (ActiveCell.Offset(33, 0).Value)
xb40 = (ActiveCell.Offset(37, 0).Value)
xb41 = (ActiveCell.Offset(38, 0).Value)
xb42 = (ActiveCell.Offset(39, 0).Value)
xb43 = (ActiveCell.Offset(40, 0).Value)
xb44 = (ActiveCell.Offset(41, 0).Value)
xb45 = (ActiveCell.Offset(42, 0).Value)
xb46 = (ActiveCell.Offset(43, 0).Value)
xb47 = (ActiveCell.Offset(44, 0).Value)
xb48 = (ActiveCell.Offset(45, 0).Value)
Sheets("Tech Collection Database").Select
ActiveCell.Value = xb3
ActiveCell.Offset(0, 1).Value = xb4
ActiveCell.Offset(0, 2).Value = xb5
ActiveCell.Offset(0, 3).Value = xb6
ActiveCell.Offset(0, 4).Value = xb7
ActiveCell.Offset(0, 5).Value = xb8
ActiveCell.Offset(0, 6).Value = xb9
ActiveCell.Offset(0, 7).Value = xb10
ActiveCell.Offset(0, 8).Value = xb11
ActiveCell.Offset(0, 9).Value = xb12
ActiveCell.Offset(0, 10).Value = xb15
ActiveCell.Offset(0, 11).Value = xb16
ActiveCell.Offset(0, 12).Value = xb17
ActiveCell.Offset(0, 13).Value = xb18
ActiveCell.Offset(0, 14).Value = xb19
ActiveCell.Offset(0, 15).Value = xb20
ActiveCell.Offset(0, 16).Value = xb21
ActiveCell.Offset(0, 17).Value = xb22
ActiveCell.Offset(0, 18).Value = xb24
ActiveCell.Offset(0, 19).Value = xc24
ActiveCell.Offset(0, 20).Value = xd24
ActiveCell.Offset(0, 21).Value = xe24
ActiveCell.Offset(0, 22).Value = xb25
ActiveCell.Offset(0, 23).Value = xb26
ActiveCell.Offset(0, 24).Value = xc26
ActiveCell.Offset(0, 25).Value = xd26
ActiveCell.Offset(0, 26).Value = xe26
ActiveCell.Offset(0, 27).Value = xb27
ActiveCell.Offset(0, 28).Value = xc27
ActiveCell.Offset(0, 29).Value = xd27
ActiveCell.Offset(0, 30).Value = xe27
ActiveCell.Offset(0, 31).Value = xb28
ActiveCell.Offset(0, 32).Value = xc28
ActiveCell.Offset(0, 33).Value = xd28
ActiveCell.Offset(0, 34).Value = xe28
ActiveCell.Offset(0, 35).Value = xb30
ActiveCell.Offset(0, 36).Value = xc30
ActiveCell.Offset(0, 37).Value = xd30
ActiveCell.Offset(0, 38).Value = xe30
ActiveCell.Offset(0, 39).Value = xb32
ActiveCell.Offset(0, 40).Value = xb34
ActiveCell.Offset(0, 41).Value = xb36
ActiveCell.Offset(0, 42).Value = xb40
ActiveCell.Offset(0, 43).Value = xb41
ActiveCell.Offset(0, 44).Value = xb42
ActiveCell.Offset(0, 45).Value = xb43
ActiveCell.Offset(0, 46).Value = xb44
ActiveCell.Offset(0, 47).Value = xb45
ActiveCell.Offset(0, 48).Value = xb46
ActiveCell.Offset(0, 49).Value = xb47
ActiveCell.Offset(0, 50).Value = xb48
End Sub
The first section is where I am copying the data from and the second section is where I am pasting the data to
This is what I have used to step though every sheet except for one:
For Each Sh In MyWkBk.Sheets
If Sh.Name <> "Reference" Then
'....
'Your Code Here
'....
End If
Next
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)