Updating multiple sheets with a userform - vba

I have created a userform which searched a reference number and then populates the userform fields with entries on the line of that reference number in a "Mastersheet". The thing is that reference may actually be on 3 sheets with the same information and what I am wanting to do, is when I update the information pulled onto the userform to update all 3 sheets. Can you please assist?
Private Sub Update_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Set ws1 = Worksheets("MasterData")
Set ws2 = Worksheets("X")
Set ws3 = Worksheets("A")
Set ws4 = Worksheets("C")
mysearch = Me.Search.Value
With ThisWorkbook.Sheets("MasterData")
Set searchRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
foundCell.Offset(0, 11).Value = Me.RD.Value
foundCell.Offset(0, 17).Value = Me.DD.Value
foundCell.Offset(0, 12).Value = Me.PD.Value
foundCell.Offset(0, 13).Value = Me.NP.Value
foundCell.Offset(0, 14).Value = Me.Brd.Value
foundCell.Offset(0, 15).Value = Me.Com.Value
foundCell.Offset(0, 25).Value = Me.Dt.Value
foundCell.Offset(0, 20).Value = Me.PrGp.Value
foundCell.Offset(0, 21).Value = Me.Iss.Value
foundCell.Offset(0, 7).Value = Me.CVal.Value
foundCell.Offset(0, 22).Value = Me.Un.Value
foundCell.Offset(0, 23).Value = Me.Wt.Value
foundCell.Offset(0, 24).Value = Me.Invd.Value
foundCell.Offset(0, 26).Value = Me.Sh.Value
foundCell.Offset(0, 19).Value = Me.FS.Value
foundCell.Offset(0, 18).Value = Me.LN.Value
foundCell.Offset(0, 16).Value = Me.Add.Value
Else
MsgBox "ID does not exist."
End If
End Sub

Rather than dimming each sheet, what about just creating a collection for them, using a generic worksheet object, and iterating through the collection? see below.
Private Sub Update_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
Dim ws As Worksheet
Dim sheetCollection As Collection
Set sheetCollection = New Collection
With sheetCollection
.Add Worksheets("MasterData"), Worksheets("MasterData").Name
.Add Worksheets("X"), Worksheets("X").Name
.Add Worksheets("A"), Worksheets("A").Name
.Add Worksheets("C"), Worksheets("C").Name
End With
mysearch = Me.Search.Value
For Each ws In sheetCollection
With ws
Set searchRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
foundCell.Offset(0, 11).Value = Me.RD.Value
foundCell.Offset(0, 17).Value = Me.DD.Value
foundCell.Offset(0, 12).Value = Me.PD.Value
foundCell.Offset(0, 13).Value = Me.NP.Value
foundCell.Offset(0, 14).Value = Me.Brd.Value
foundCell.Offset(0, 15).Value = Me.Com.Value
foundCell.Offset(0, 25).Value = Me.Dt.Value
foundCell.Offset(0, 20).Value = Me.PrGp.Value
foundCell.Offset(0, 21).Value = Me.Iss.Value
foundCell.Offset(0, 7).Value = Me.CVal.Value
foundCell.Offset(0, 22).Value = Me.Un.Value
foundCell.Offset(0, 23).Value = Me.Wt.Value
foundCell.Offset(0, 24).Value = Me.Invd.Value
foundCell.Offset(0, 26).Value = Me.Sh.Value
foundCell.Offset(0, 19).Value = Me.FS.Value
foundCell.Offset(0, 18).Value = Me.Ln.Value
foundCell.Offset(0, 16).Value = Me.Add.Value
Else
MsgBox "ID(" & mysearch & ") does not exist in " & ws.name
End If
Next ws
End Sub

Related

Find Function in a Userform based on multiple criteria

I created a userform which has several textboxes and I use the foundcell to return the values of a line based on a reference number.
What I am wanting to do however is search a reference which is based in the searchrange below which is in and if .Range("AK") is blank to return. Else a msgbox to say that the criteria is not valid.
Please see me attempted code
Private Sub CommandButton1_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
mysearch = Ref.Value
With Sheets("X")
Set searchRange = Sheets("X").Range("AB2", .Range("AB" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell And foundCell.Offset(0, 9) Is Nothing Then
Me.C.Value = foundCell.Offset(0, -12).Value
Me.DD.Value = foundCell.Offset(0, -10).Value
Me.RD.Value = foundCell.Offset(0, -16).Value
Me.BN.Value = foundCell.Offset(0, -9).Value
Me.FN.Value = foundCell.Offset(0, -8).Value
Me.SHARP.Value = foundCell.Offset(0, -1).Value
Me.PGP.Value = foundCell.Offset(0, -7).Value
Me.ISS.Value = foundCell.Offset(0, -6).Value
Me.DE.Value = foundCell.Offset(0, -2).Value
Me.UN.Value = foundCell.Offset(0, -5).Value
Me.W.Value = foundCell.Offset(0, -4).Value
Me.IN.Value = foundCell.Offset(0, -3).Value
Me.CVAL.Value = foundCell.Offset(0, -20).Value
Me.ADD.Value = foundCell.Offset(0, -11).Value
Me.RESPONSE.Value = foundCell.Offset(0, 1).Value
Me.NRESPONSE.Value = foundCell.Offset(0, 2).Value
Me.MAREC.Value = foundCell.Offset(0, 4).Value
Me.MORET.Value = foundCell.Offset(0, 5).Value
Me.CNREC.Value = foundCell.Offset(0, 8).Value
Me.CNREF.Value = foundCell.Offset(0, 6).Value
Me.NVALUE.Value = foundCell.Offset(0, 7).Value
Me.CBY.Value = foundCell.Offset(0, 10).Value
Me.CDAT.Value = foundCell.Offset(0, 11).Value
Else
MsgBox "The Reference you have entered does not qualify and cannot be located. Please try another reference!"
End If
End Sub
You need to null-check foundCell on its own conditional, VBA's And logical operator doesn't short-circuit like VB.NET's AndAlso and C#'s && operator.
If Not foundCell Is Nothing Then
Also foundCell.Offset(0,9) could contain an error value, which will make any comparison operation throw a "Type Mismatch" run-time error. Use IsError to verify its error state before you assume it contains anything other than an error:
If Not IsError(foundCell.Offset(0, 9).Value) Then
Lastly, if your intent is to verify whether foundCell.Offset(0, 9) isn't empty, you can check in several ways, but Is Nothing isn't one of them:
IsBlank(foundCell.Offset(0, 9).Value) will return True if the cell contains nothing - no value, no formula.
foundCell.Offset(0, 9).Value <> vbNullString will return True if the cell's value is an empty string, or if its formula evaluates to an empty string.
foundCell.Offset(0, 9).Value <> "" will do the same as <> vbNullString.
Thus:
If Not foundCell Is Nothing Then
If Not IsBlank(foundCell.Offset(0, 9).Value) Then
Or:
If Not foundCell Is Nothing Then
If Not IsError(foundCell.Offset(0, 9).Value) Then
If foundCell.Offset(0, 9).Value <> vbNullString Then
If Not foundCell Is Nothing And foundCell.Offset(0, 9) <> """" Then

Left function VBA

Hi to Any and all willing to assist.
I appear to be having issues with the left function in VBA. I am looking to search using a reference number and then the userform will pull through data that is stored within a table. In 1 section of the userform I have 4 text boxes looking to pull through different sections of 1 cell. The trouble is that I am getting "FO" for the answer on this for every reference which is actually looking at the fo within my code please see below.
Private Sub Find_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
mysearch = Me.Search.Value
With ThisWorkbook.Sheets("Master Data")
Set searchRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
Me.BDM.Value = foundCell.Offset(0, 6).Value
Me.Mrch.Value = foundCell.Offset(0, 7).Value
Me.EUs.Value = foundCell.Offset(0, 8).Value
Me.Pr.Value = foundCell.Offset(0, 10).Value
Me.Qty.Value = foundCell.Offset(0, 11).Value
Me.RsnCd.Value = foundCell.Offset(0, 12).Value
Me.ReOrCd.Value = foundCell.Offset(0, 13).Value
Me.Tot.Value = foundCell.Offset(0, 5).Value
Me.V.Value = Me.Total.Value / 1.2
Me.VT.Value = Me.Total.Value - Me.Value.Value
Me.Req.Value = foundCell.Offset(0, 17).Value
Me.Appl.Value = foundCell.Offset(0, 18).Value
Me.Line1.Value = foundCell.Offset(0, 19).Value
Me.Line2.Value = foundCell.Offset(0, 20).Value
Me.Ci.Value = foundCell.Offset(0, 21).Value
Me.Poe.Value = foundCell.Offset(0, 22).Value
Me.SC1.Value = Left(foundCell.Offset(0, 23).Value, 2)
'this is where in code I am receiving fo from the foundcell everytime
Else
MsgBox "ID does not exist."
End If
End Sub
I always thought the left in vba worked the same as excel which is left(a2, 2) for example
Unsure why but simply restarting excel resolved the issue and no issue with code

Find function not working until table modified

I was wondering if anyone can assist at all please.
I have created a userform within Excel and using a reference number it will return the values of the given row within a table. The issue I am currently receiving is when I initially open the workbook that the find function does not work and comes back with the Msgbox given in the code "ID does not exist".
However if I use the userform to create a new line within the table then after this the find function is working absolutely fine. Has anyone got any suggestions?
Private Sub Find_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
mysearch = Me.Search.Value
With ThisWorkbook.Sheets("Master Data")
Set searchRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
Me.RsnDc = foundCell.Offset(0, 4).Value
Me.BDM.Value = foundCell.Offset(0, 6).Value
Me.MIns.Value = foundCell.Offset(0, 7).Value
Me.EUs.Value = foundCell.Offset(0, 8).Value
Me.In.Value = foundCell.Offset(0, 9).Value
Me.Pr.Value = foundCell.Offset(0, 10).Value
Me.Qu.Value = foundCell.Offset(0, 11).Value
Me.ReCd.Value = foundCell.Offset(0, 12).Value
Me.ReOrCd.Value = foundCell.Offset(0, 13).Value
Me.Ttl.Value = foundCell.Offset(0, 5).Value
Me.Va.Value = Me.Total.Value / 1.2
Me.VT.Value = Me.Total.Value - Me.Value.Value
Me.R.Value = foundCell.Offset(0, 17).Value
Me.App.Value = foundCell.Offset(0, 18).Value
Me.L1.Value = foundCell.Offset(0, 19).Value
Me.L2.Value = foundCell.Offset(0, 20).Value
Me.CY.Value = foundCell.Offset(0, 21).Value
Me.PC.Value = foundCell.Offset(0, 22).Value
Me.SN1.Value = Left(foundCell.Offset(0, 23).Value, 2)
Me.SN2.Value = Mid(foundCell.Offset(0, 23).Value, 3, 2)
Me.SN3.Value = Right(foundCell.Offset(0, 23).Value, 2)
Me.ANCT.Value = foundCell.Offset(0, 24).Value
Else
MsgBox "ID does not exist."
End If
End Sub
I commented out all of the other text boxes and removed "Me" from the "Search.Value" and it works fine. So it's either in the "Me" or somewhere in your list of other textboxes. Try commenting them out half at a time to narrow it down.
Private Sub CommandButton1_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
mysearch = Search.Value
With ThisWorkbook.Sheets("Master Data")
Set searchRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
' Me.RsnDc = foundCell.Offset(0, 4).Value
' Me.BDM.Value = foundCell.Offset(0, 6).Value
' Me.MIns.Value = foundCell.Offset(0, 7).Value
' Me.EUs.Value = foundCell.Offset(0, 8).Value
' Me.In.Value = foundCell.Offset(0, 9).Value
' Me.Pr.Value = foundCell.Offset(0, 10).Value
' Me.Qu.Value = foundCell.Offset(0, 11).Value
' Me.ReCd.Value = foundCell.Offset(0, 12).Value
' Me.ReOrCd.Value = foundCell.Offset(0, 13).Value
' Me.Ttl.Value = foundCell.Offset(0, 5).Value
' Me.Va.Value = Me.Total.Value / 1.2
' Me.VT.Value = Me.Total.Value - Me.Value.Value
' Me.r.Value = foundCell.Offset(0, 17).Value
' Me.App.Value = foundCell.Offset(0, 18).Value
' Me.L1.Value = foundCell.Offset(0, 19).Value
' Me.L2.Value = foundCell.Offset(0, 20).Value
' Me.cy.Value = foundCell.Offset(0, 21).Value
' Me.pc.Value = foundCell.Offset(0, 22).Value
' Me.SN1.Value = Left(foundCell.Offset(0, 23).Value, 2)
' Me.SN2.Value = Mid(foundCell.Offset(0, 23).Value, 3, 2)
' Me.SN3.Value = Right(foundCell.Offset(0, 23).Value, 2)
' Me.ANCT.Value = foundCell.Offset(0, 24).Value
Beep
MsgBox "FOUND IT!"
Else
MsgBox "ID does not exist."
End If
End Sub
The issue appears to have been that in the search range column A was using a formula to dictate the search criteria. I have now built this into the userform and it seems to work a dream. Thanks for your time guys.

Unable to copy from a set sheet when looping through data

I had an earlier question which was kindly answered and I was given the following code which worked perfectly in a test environment where the code was looping through 3 sheets with only 1 sheet of data and 3 columns.
Below is my ammended code to go through 16 columns. The issue however I believe I am facing is when opening a sheet in the live environment the sub workbooks all contain 4 tabs which are "Lookup", "Detail", "Summary" and "Calls".
The code contains For Each sheet In ActiveWorkbook.Worksheets
I am wanting to only take the data in the below code from each workbook in the loop in the "Calls" tab. Can anyone recommend any change to the existing loop to do this?
Sub Theloopofloops()
Dim wbk As Workbook
Dim Filename As String
Dim path As String
Dim rCell As Range
Dim rRng As Range
Dim wsO As Worksheet
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets(Sheet2)
path = "M:\Documents\Call Logger\"
Filename = Dir(path & "*.xlsm")
Set wsO = ThisWorkbook.Sheets("Master")
Do While Len(Filename) > 0
DoEvents
Set wbk = Workbooks.Open(path & Filename, True, True)
For Each sheet In ActiveWorkbook.Worksheets
Set rRng = sheet.Range("A2:A20000")
For Each rCell In rRng.Cells
If rCell <> "" And rCell.Value <> vbNullString And rCell.Value <> 0 Then
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = rCell
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 1).Value = rCell.Offset(0, 1)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 2).Value = rCell.Offset(0, 2)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 3).Value = rCell.Offset(0, 3)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 4).Value = rCell.Offset(0, 4)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 5).Value = rCell.Offset(0, 5)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 6).Value = rCell.Offset(0, 6)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 7).Value = rCell.Offset(0, 7)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 8).Value = rCell.Offset(0, 8)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 9).Value = rCell.Offset(0, 9)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 10).Value = rCell.Offset(0, 10)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 11).Value = rCell.Offset(0, 11)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 12).Value = rCell.Offset(0, 12)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 13).Value = rCell.Offset(0, 13)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 14).Value = rCell.Offset(0, 14)
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 15).Value = rCell.Offset(0, 15)
End If
Next rCell
Next sheet
wbk.Close False
Filename = Dir
Loop
End Sub
Instead of using the loop, just replace the For Each sheet ... line with
Set sheet = wbk.Worksheets("Calls")
(and remove Next sheet)
You could even shorten that and use
Set rRng = wbk.Worksheets("Calls").Range("A2:A20000")
or even skip that and use
For Each rCell In wbk.Worksheets("Calls").Range("A2:A20000").Cells
You can also shorten the copying by using
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 16).Value = rCell.Resize(1, 16).Value
you may be after what follows:
Option Explicit
Sub Theloopofloops()
Dim wbk As Workbook
Dim Filename As String
Dim path As String
Dim rCell As Range
Dim wsO As Worksheet
path = "M:\Documents\Call Logger\"
Filename = Dir(path & "*.xlsm")
Set wsO = ThisWorkbook.Sheets("Master")
Do While Len(Filename) > 0
DoEvents
Set wbk = Workbooks.Open(path & Filename, True, True)
For Each rCell In ActiveWorkbook.Worksheets("Calls").Range("A2:A20000")
If rCell <> "" And rCell.Value <> vbNullString And rCell.Value <> 0 Then
wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 16).Value = rCell.Resize(, 16).Value
End If
Next rCell
wbk.Close False
Filename = Dir
Loop
End Sub

If combobox equal to empty, do not copy userform data to excel sheet

I have create 2 sub function like this:
Sub Product1()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Inventory")
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
With ws
If IsEmpty(UserForm5.ComboBox5.Value) Then
Exit Sub
Else
.Cells(lRow, 1).Value = UserForm5.TextBox1.Value
.Cells(lRow, 2).Value = UserForm5.ComboBox2.Value
.Cells(lRow, 3).Value = UserForm5.ComboBox3.Value
.Cells(lRow, 4).Value = UserForm5.ComboBox4.Value
.Cells(lRow, 5).Value = UserForm5.ComboBox1.Value
.Cells(lRow, 6).Value = UserForm5.ComboBox5.Value
.Cells(lRow, 7).Value = UserForm5.TextBox2.Value
.Cells(lRow, 8).Value = UserForm5.TextBox5.Value
.Cells(lRow, 9).Value = UserForm5.TextBox6.Value
.Cells(lRow, 10).Value = UserForm5.TextBox4.Value
.Cells(lRow, 11).Value = UserForm5.TextBox7.Value
End If
End With
End Sub
Sub Product2()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Inventory")
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
With ws
If IsEmpty(UserForm5.ComboBox6.Value) Then
Exit Sub
Else
.Cells(lRow, 1).Value = UserForm5.TextBox1.Value
.Cells(lRow, 2).Value = UserForm5.ComboBox2.Value
.Cells(lRow, 3).Value = UserForm5.ComboBox3.Value
.Cells(lRow, 4).Value = UserForm5.ComboBox4.Value
.Cells(lRow, 5).Value = UserForm5.ComboBox1.Value
.Cells(lRow, 6).Value = UserForm5.ComboBox6.Value
.Cells(lRow, 7).Value = UserForm5.TextBox9.Value
.Cells(lRow, 8).Value = UserForm5.TextBox11.Value
.Cells(lRow, 9).Value = UserForm5.TextBox12.Value
.Cells(lRow, 10).Value = UserForm5.TextBox10.Value
.Cells(lRow, 11).Value = UserForm5.TextBox8.Value
End If
End With
End Sub
I was wondering that, if my combobox6 is empty, it should not transfer the data for to exel sheet.
What I faced now is if the combobox6 is empty( did not select any value), it will still copy all the data to the excel sheet.
Is there any way to fix it?
Change
If IsEmpty(UserForm5.ComboBox5.Value) Then
to
If UserForm5.ComboBox5.Value = "" Then
And make the same sort of change to the Product2 sub.
If the combo box is "empty" then checking its value will give you an empty string.
Sub Product1()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Inventory")
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
With ws
If UserForm5.ComboBox5.Value <> "" Then
Exit Sub
Else
.Cells(lRow, 1).Value = UserForm5.TextBox1.Value
.Cells(lRow, 2).Value = UserForm5.ComboBox2.Value
.Cells(lRow, 3).Value = UserForm5.ComboBox3.Value
.Cells(lRow, 4).Value = UserForm5.ComboBox4.Value
.Cells(lRow, 5).Value = UserForm5.ComboBox1.Value
.Cells(lRow, 6).Value = UserForm5.ComboBox5.Value
.Cells(lRow, 7).Value = UserForm5.TextBox2.Value
.Cells(lRow, 8).Value = UserForm5.TextBox5.Value
.Cells(lRow, 9).Value = UserForm5.TextBox6.Value
.Cells(lRow, 10).Value = UserForm5.TextBox4.Value
.Cells(lRow, 11).Value = UserForm5.TextBox7.Value
End If
End With
End Sub
Sub Product2()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Inventory")
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
With ws
If UserForm5.ComboBox6.Value <> "" Then
Exit Sub
Else
.Cells(lRow, 1).Value = UserForm5.TextBox1.Value
.Cells(lRow, 2).Value = UserForm5.ComboBox2.Value
.Cells(lRow, 3).Value = UserForm5.ComboBox3.Value
.Cells(lRow, 4).Value = UserForm5.ComboBox4.Value
.Cells(lRow, 5).Value = UserForm5.ComboBox1.Value
.Cells(lRow, 6).Value = UserForm5.ComboBox6.Value
.Cells(lRow, 7).Value = UserForm5.TextBox9.Value
.Cells(lRow, 8).Value = UserForm5.TextBox11.Value
.Cells(lRow, 9).Value = UserForm5.TextBox12.Value
.Cells(lRow, 10).Value = UserForm5.TextBox10.Value
.Cells(lRow, 11).Value = UserForm5.TextBox8.Value
End If
End With
End Sub