VBA Excel autofill the table based on userform, when data comes from the other sheet

问题

Good afternoon,

I would like to get the result in the table, where the data comes from my user form. As you can see below, column H comprises the sum of column G from my active worksheet and column AD from my external worksheet, which is "Formulas".

Now, I have the user forum, which is going to fill up my whole row in the table as I input some data in this user form. The column H won't be input directly from the Userform, because it includes the formula mentioned above. I want to auto-populate this column H, when making input to adjacent column G and also column L. This auto-population must be based on the formula described above, where the column AD from the "Formulas" sheet is based on the IF statement as shown in the picture below. This IF statement is related to column L from my active worksheet, determining the integer value ranges.

For this purpose, I used the following code for making the input from my user form. Modifying it further by inserting the potential solution for the aforementioned column H auto-population.

 Private Sub CommandButton1_Click()
 Dim wks As Worksheet, wkf As Worksheet
 Set wks = ThisWorkbook.Sheets("Tracker")
 Set wks = ThisWorkbook.Sheets("Formulas")
 AppendToColumn wks, "A", JobID.Text  'Adds the TextBox3 into Col A & Last Blank Row
 AppendToColumn wks, "B", CoordName.Text
 AppendToColumn wks, "C", PlannerName.Text
 AppendToColumn wks, "D", Surveyor.Text
 AppendToColumn wks, "E", RRGuy.Text
 AppendToColumn wks, "F", DateBox.Text
 AppendToColumn wks, "G", TimeBox.Text
 AppendToColumn wks, "I", AddressBox.Text
 AppendToColumn wks, "J", CityBox.Text
 AppendToColumn wks, "K", PostcodeBox.Text
 AppendToColumn wks, "L", THPBox.Text
 AppendToColumn wks, "M", JointBox.Text

 Dim lastrowG As Long, ListIndex As Long
 lastrowG = AppendToColumn(wks, "G", TimeBox.Text)
 lastrowAD = wks.Range("AD" & ListIndex + 1)
 AppendToColumn wks, "H", ("=G" & lastrowG & " + Formulas!AD" & lastrowAD)



MsgBox ("All data has been added successfully")
   End Sub

     Private Function AppendToColumn(ByRef ws As Worksheet, _
                            ByVal columm As Variant, _
                            ByVal value As Variant, _
                            Optional ByVal kindOfValue As DataType = 
 DataValue) As Long
'--- copies the given value to the first empty cell in the
'    specified column. the "columm" value can be either numeric
'    or alphabetic. RETURNS the index of the last row
Dim colIndex As Long
Dim lastRow As Long
Dim firstEmptyRow As Long
With ws
    '--- quick conversion to make sure we have a numeric column index
    colIndex = IIf(IsNumeric(columm), columm, .Cells(1, columm).Column)
    lastRow = .Cells(.Rows.Count, colIndex).End(xlUp).Row
    '--- if the column is completely empty, the first empty row is 1,
    '    otherwise it's one row down from the last row
    firstEmptyRow = IIf(IsEmpty(.Cells(lastRow, colIndex)), 1, lastRow + 1)
    Select Case kindOfValue
    Case DataValue
        .Cells(firstEmptyRow, colIndex).value = value
    Case FormulaValue
        .Cells(firstEmptyRow, colIndex).Formula = value
    End Select
   End With
   AppendToColumn = lastRow
 End Function

Finally I am getting error:

Type mismatch

indicating the following lines:

 lastrowAD = wks.Range("AD" & ListIndex + 1)
 AppendToColumn wks, "H", ("=G" & lastrowG & " + Formulas!AD" & lastrowAD)

Is there any way to make this solution running?

回答1:

The code snip you posted does not compile. This makes helping you very difficult. Be sure to only post the minimum code required to reproduce the issue you are having. lastrowAD is not declared. You need to put Option Explicit at the top of EVERY module. This forces you to declare all of your variables. When you control the type of each variable you will no longer get type mismatches.

I can tell by your usage that lastrowAD is a Long. You are assigning your long with a range object. That is indeed a type mismatch. If we do what your code SAYS I can get the last row of column AD and that will solve the problem.

Option Explicit

Private Sub CommandButton1_Click()
    Dim wks As Worksheet, wkf As Worksheet
    Set wks = ThisWorkbook.Sheets("Tracker")
    Set wks = ThisWorkbook.Sheets("Formulas")
    AppendToColumn wks, "A", JobID.Text  'Adds the TextBox3 into Col A & Last Blank Row
    AppendToColumn wks, "B", CoordName.Text
    AppendToColumn wks, "C", PlannerName.Text
    AppendToColumn wks, "D", Surveyor.Text
    AppendToColumn wks, "E", RRGuy.Text
    AppendToColumn wks, "F", DateBox.Text
    AppendToColumn wks, "G", TimeBox.Text
    AppendToColumn wks, "I", AddressBox.Text
    AppendToColumn wks, "J", CityBox.Text
    AppendToColumn wks, "K", PostcodeBox.Text
    AppendToColumn wks, "L", THPBox.Text
    AppendToColumn wks, "M", JointBox.Text

    Dim lastrowG As Long, ListIndex As Long
    Dim lastrowAD As Long
    lastrowG = AppendToColumn(wks, "G", TimeBox.Text)
    lastrowAD = wks.Range("AD" & Rows.CountLarge).End(xlUp).Row
    AppendToColumn wks, "H", ("=G" & lastrowG & " + Formulas!AD" & lastrowAD)

    MsgBox ("All data has been added successfully")
End Sub

回答2:

Here is the error. Procedure will only consider the last Set wks and hence ther is no reference to ThisWorkbook.Sheets("Tracker") in the procedure. That is the cause of the error.

Set wks = ThisWorkbook.Sheets("Tracker")
Set wks = ThisWorkbook.Sheets("Formulas")

Also, I don't see how you are incrementing value of ListIndex. So, lastrowAD will always be = wks range AD1

回答3:

I solved it eventually this way:

 Private Sub CommandButton1_Click()
 Dim wks As Worksheet, wkf As Worksheet
 Dim lastrowG As Long, lastrowL As Long, LastrowH As Long, LastrowS As Long, LastrowAF 
 As Long, LastrowAE As Long, ListIndex As Long
 Set wks = ThisWorkbook.Sheets("Tracker")
 Set wkf = ThisWorkbook.Sheets("Formulas")
AppendToColumn wks, "A", JobID.Text  'Adds the TextBox3 into Col A & Last Blank Row
AppendToColumn wks, "B", CoordName.Text
AppendToColumn wks, "C", PlannerName.Text
AppendToColumn wks, "D", Surveyor.Text
AppendToColumn wks, "E", RRGuy.Text
AppendToColumn wks, "F", DateBox.Text
AppendToColumn wks, "G", TimeBox.Text
'AppendToColumn wks, "H", TimeEndBox.Text
AppendToColumn wks, "I", AddressBox.Text
AppendToColumn wks, "J", CityBox.Text
AppendToColumn wks, "K", PostcodeBox.Text
AppendToColumn wks, "L", THPBox.Text
AppendToColumn wks, "M", JointBox.Text
AppendToColumn wks, "N", FibreBox.Text
AppendToColumn wks, "O", FibreEquipmentBox.Text
AppendToColumn wks, "P", SpareFibreBox.Text

lLastrowG = wks.Range("G" & Rows.Count).End(xlUp).Row
LastrowH = wks.Range("H" & Rows.Count).End(xlUp).Row + 1
LastrowL = wks.Range("L" & Rows.Count).End(xlUp).Row
LastrowAF = wkf.Range("AF" & Rows.Count).End(xlUp).Row + 1

'LastrowAE = Sheets("Formulas").Range("AE" & Rows.Count).End(xlUp).Row + 1
 wkf.Range("AF" & LastrowAF).Formula = _
"=IF(Tracker!L" & lastrowL & "<20,""1:00"",""2:00"")"
'wkf.Range("AE" & LastrowAE).value = ("=Formulas!AD" & LastrowAD)
 wks.Range("H" & LastrowH).value = ("=G" & lastrowG & "+Formulas!AF" & LastrowAF)

MsgBox ("All data has been added successfully")

End Sub

where I parsed the Excel IF statement into the VBA code.

来源：https://stackoverflow.com/questions/62285689/vba-excel-autofill-the-table-based-on-userform-when-data-comes-from-the-other-s

标签

excel

vba

excel-formula