Hi and thanks in advance I am new to excel vba and need help on some little problem
I receive an adhoc task from my boss to using excel vba to compile report. This task need 2 workbook to be using. 1 is source workbook: Product.xlsx and another one is targeted workboook:Report Template.xlsx
What I need to do is if all the criteria input in the userform is found in the source workbook it will copy all the related data. I managed to do so but the problem is the column index is set by me, I need help on this if there is a way to replace this column index by using looping or another way to do so.
The source workbook contain enourmous row of data and about 54 columns. The data need to be pasted on the targeted workbook is need to exclude some columns in the source workbook. Here is my code:
Dim LastRow As Long
Dim i As Long
Dim erow As Long
Dim wbk As Workbook
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
Dim Fab, Test As String
Dim Machine, Year, WW As String
Fab = FabTextBox.Text
Year = YearComboBox.Text
WW = WWComboBox.Text
Test = TestTypeComboBox.Text
Set SourceSheet = ActiveSheet
With SourceSheet
LastRow = .Range("A4").SpecialCells(xlCellTypeLastCell).Row
If Test = "Test A" Then
Set wbk = Workbooks.Open("Report Template1.xlsx")
Set DestSheet = wbk.Sheets("Cover")
Else
Set wbk = Workbooks.Open("Report Template2.xlsx")
Set DestSheet = wbk.Sheets("Cover")
End If
With DestSheet
.Columns(3).NumberFormat = "hh:mm:ss AM/PM"
End With
For i = 2 To LastRow
If SourceSheet.Cells(i, 4).Value = Fab Then
If SourceSheet.Cells(i, 6).Value = Year Then
If SourceSheet.Cells(i, 7).Value = WW Then
If SourceSheet.Cells(i, 9).Value = Test Then
erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'change the column numbers to the relevant number
DestSheet.Cells(erow, 1).Value = SourceSheet.Cells(i, 2).Value
DestSheet.Cells(erow, 2).Value = SourceSheet.Cells(i, 10).Value
DestSheet.Cells(erow, 3).Value = SourceSheet.Cells(i, 11).Value
DestSheet.Cells(erow, 4).Value = SourceSheet.Cells(i, 12).Value
DestSheet.Cells(erow, 5).Value = SourceSheet.Cells(i, 13).Value
DestSheet.Cells(erow, 6).Value = SourceSheet.Cells(i, 14).Value
DestSheet.Cells(erow, 7).Value = SourceSheet.Cells(i, 15).Value
DestSheet.Cells(erow, 8).Value = SourceSheet.Cells(i, 16).Value
DestSheet.Cells(erow, 9).Value = SourceSheet.Cells(i, 17).Value
DestSheet.Cells(erow, 10).Value = SourceSheet.Cells(i, 18).Value
DestSheet.Cells(erow, 11).Value = SourceSheet.Cells(i, 19).Value
DestSheet.Cells(erow, 12).Value = SourceSheet.Cells(i, 20).Value
DestSheet.Cells(erow, 13).Value = SourceSheet.Cells(i, 21).Value
DestSheet.Cells(erow, 14).Value = SourceSheet.Cells(i, 22).Value
DestSheet.Cells(erow, 15).Value = SourceSheet.Cells(i, 23).Value
DestSheet.Cells(erow, 16).Value = SourceSheet.Cells(i, 24).Value
DestSheet.Cells(erow, 17).Value = SourceSheet.Cells(i, 25).Value
DestSheet.Cells(erow, 18).Value = SourceSheet.Cells(i, 26).Value
DestSheet.Cells(erow, 19).Value = SourceSheet.Cells(i, 27).Value
DestSheet.Cells(erow, 20).Value = SourceSheet.Cells(i, 28).Value
DestSheet.Cells(erow, 21).Value = SourceSheet.Cells(i, 29).Value
DestSheet.Cells(erow, 22).Value = SourceSheet.Cells(i, 30).Value
DestSheet.Cells(erow, 23).Value = SourceSheet.Cells(i, 31).Value
DestSheet.Cells(erow, 24).Value = SourceSheet.Cells(i, 32).Value
DestSheet.Cells(erow, 25).Value = SourceSheet.Cells(i, 33).Value
DestSheet.Cells(erow, 26).Value = SourceSheet.Cells(i, 34).Value
DestSheet.Cells(erow, 27).Value = SourceSheet.Cells(i, 35).Value
DestSheet.Cells(erow, 28).Value = SourceSheet.Cells(i, 36).Value
DestSheet.Cells(erow, 29).Value = SourceSheet.Cells(i, 37).Value
DestSheet.Cells(erow, 30).Value = SourceSheet.Cells(i, 38).Value
DestSheet.Cells(erow, 31).Value = SourceSheet.Cells(i, 39).Value
DestSheet.Cells(erow, 32).Value = SourceSheet.Cells(i, 40).Value
DestSheet.Cells(erow, 33).Value = SourceSheet.Cells(i, 41).Value
DestSheet.Cells(erow, 34).Value = SourceSheet.Cells(i, 42).Value
DestSheet.Cells(erow, 35).Value = SourceSheet.Cells(i, 43).Value
DestSheet.Cells(erow, 36).Value = SourceSheet.Cells(i, 44).Value
DestSheet.Cells(erow, 37).Value = SourceSheet.Cells(i, 45).Value
DestSheet.Cells(erow, 38).Value = SourceSheet.Cells(i, 46).Value
DestSheet.Cells(erow, 39).Value = SourceSheet.Cells(i, 47).Value
DestSheet.Cells(erow, 40).Value = SourceSheet.Cells(i, 48).Value
DestSheet.Cells(erow, 41).Value = SourceSheet.Cells(i, 49).Value
DestSheet.Cells(erow, 42).Value = SourceSheet.Cells(i, 50).Value
DestSheet.Cells(erow, 43).Value = SourceSheet.Cells(i, 51).Value
DestSheet.Cells(erow, 44).Value = SourceSheet.Cells(i, 52).Value
DestSheet.Cells(erow, 45).Value = SourceSheet.Cells(i, 53).Value
DestSheet.Cells(erow, 46).Value = SourceSheet.Cells(i, 54).Value
End If
End If
End If
End If
Next i
And because i know how many columns in the data set I tried to replace my code as shown belows but it does not copy as code above.this code only copy data from SourceSheet.Cells(i, 2).Value
For i = 2 To LastRow
If SourceSheet.Cells(i, 4).Value = Fab Then
If SourceSheet.Cells(i, 6).Value = Year Then
If SourceSheet.Cells(i, 7).Value = WW Then
If SourceSheet.Cells(i, 9).Value = Test Then
erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'change the column numbers to the relevant number
DestSheet.Cells(erow, 1).Value = SourceSheet.Cells(i, 2).Value
For j = 2 To 46
For k = 10 To 54
DestSheet.Cells(erow, j).Value = SourceSheet.Cells(i, k).Value
Next k
Next j
End If
End If
End If
End If
Next i
You can copy the data in two operations:
Dim rwSrc as Range
For i = 2 To LastRow
Set rwSrc = SourceSheet.Rows(i)
If rwSrc.Cells(4).Value = Fab Then
If rwSrc.Cells(6).Value = Year Then
If rwSrc.Cells(7).Value = WW Then
If rwSrc.Cells(9).Value = Test Then
erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With DestSheet.rows(erow)
.cells(1).Value = rwSrc.Cells(2).Value
'adjust the 50 to match your actual data
.cells(2).Resize(1, 50).Value = rwSrc.Cells(10).Resize(1, 50).Value
End With
End If
End If
End If
End If
Next i
Related
I think this is an easy one...
I have some code that goes through a source xls file and based on the company name it will pull out sales data relevant to that company and populate it in the company's own file.
It works fine (probably not very elegant), but I want to have a condition that only returns a value in one of my columns if a condition is met.
It's the commented line in the code below - any help greatly appreciated
For i = 2 To LastRow
If SourceSheet.Cells(i, 21).Value Like "CompanyName goes here*" Then
'change the column numbers to the relevant number
Product = SourceSheet.Cells(i, 11).Value
Base Sales Value = SourceSheet.Cells(i, 27).Value
Partner = SourceSheet.Cells(i, 21).Value
EndUser = SourceSheet.Cells(i, 7).Value
License = SourceSheet.Cells(i, 13).Value
PostingMonth = SourceSheet.Cells(i, 3).Value
LicType = SourceSheet.Cells(i, 12).Value
newuplift = SourceSheet.Cells(i, 15).Value
UpliftValue = SourceSheet.Cells(i, 28).Value
erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'change the column numbers to the relevant number
DestSheet.Cells(erow, 1).Value = ProdType
DestSheet.Cells(erow, 2).Value = License
DestSheet.Cells(erow, 3).Value = Partner
DestSheet.Cells(erow, 4).Value = EndUser
DestSheet.Cells(erow, 5).Value = SOValue
DestSheet.Cells(erow, 6).Value = PostingMonth
DestSheet.Cells(erow, 7).Value = newuplift
DestSheet.Cells(erow, 8).Value = LicType
DestSheet.Cells(erow, 9).Value = UpliftValue 'TRYING TO PLACE A CONDITION HERE - SEE BELOW
' If newuplift = "Renewal" then place the Upliftvalue in row 9, otherwise set to "0"
End If
Next i
You could use IIf()
DestSheet.Cells(erow, 9).Value = IIf(newuplift = "Renewal", UpliftValue, 0)
I have an Excel (365) spreadsheet with two Comboboxes - Combobox1 and Combobox2 both are used to list the same data for different purposes on different tabs. My problem is that although I have changed listrows in both to the same number (20) only Combobox2 shows 20 rows. Combobox1 only shows the previous number of rows (15) although set to display 20. Anyone know how to get it to behave properly?
EDIT I have solved my origional problem but I would however be interested in using VBA to automatically update both listfillrange and listrows when a new row of data is added. I do have a macro that I use to add new data to my data table that could be adapted to also update listfillrange and listrows
Sub add_to_table_sa_3()
'Written by Keith Cooper 27/10/2021
Dim NewRow As Integer
NewRow = Worksheets("input").Range("E1").Value + 1
If Worksheets("input").Range("F1").Value <> 0 Then
MsgBox "There are errors. No data has been added!", vbOKOnly, "Warning!"
Exit Sub
End If
Worksheets("Data").Cells(NewRow, 1).Value = Worksheets("input").Range("B3").Value
Worksheets("Data").Cells(NewRow, 2).Value = Worksheets("input").Range("B4").Value
Worksheets("Data").Cells(NewRow, 3).Value = Worksheets("input").Range("B5").Value
Worksheets("Data").Cells(NewRow, 4).Value = Worksheets("input").Range("B6").Value
Worksheets("Data").Cells(NewRow, 5).Value = Worksheets("input").Range("B7").Value
Worksheets("Data").Cells(NewRow, 6).Value = Worksheets("input").Range("B8").Value
Worksheets("Data").Cells(NewRow, 7).Value = Worksheets("input").Range("B9").Value
Worksheets("Data").Cells(NewRow, 8).Value = Worksheets("input").Range("B10").Value
Worksheets("Data").Cells(NewRow, 9).Value = Worksheets("input").Range("B11").Value
Worksheets("Data").Cells(NewRow, 10).Value = Worksheets("input").Range("B12").Value
Worksheets("Data").Cells(NewRow, 11).Value = Worksheets("input").Range("B13").Value
Worksheets("Data").Cells(NewRow, 12).Value = Worksheets("input").Range("B14").Value
Worksheets("Data").Cells(NewRow, 13).Value = Worksheets("input").Range("B15").Value
Worksheets("Data").Cells(NewRow, 14).Value = Worksheets("input").Range("B16").Value
Worksheets("Data").Cells(NewRow, 15).Value = Worksheets("input").Range("B17").Value
Worksheets("Data").Cells(NewRow, 16).Value = Worksheets("input").Range("B18").Value
Worksheets("Data").Cells(NewRow, 17).Value = Worksheets("input").Range("B19").Value
Worksheets("Data").Cells(NewRow, 18).Value = Worksheets("input").Range("B20").Value
Worksheets("Data").Cells(NewRow, 19).Value = Worksheets("input").Range("B21").Value
Worksheets("Data").Cells(NewRow, 20).Value = Worksheets("input").Range("B22").Value
Worksheets("Data").Cells(NewRow, 21).Value = Worksheets("input").Range("B23").Value
Worksheets("Data").Cells(NewRow, 22).Value = Worksheets("input").Range("B24").Value
Worksheets("Data").Cells(NewRow, 23).Value = Worksheets("input").Range("B25").Value
Worksheets("Data").Cells(NewRow, 24).Value = Worksheets("input").Range("B26").Value
Worksheets("Data").Cells(NewRow, 25).Value = Worksheets("input").Range("B27").Value
Worksheets("Data").Cells(NewRow, 26).Value = Worksheets("input").Range("B28").Value
Worksheets("Data").Cells(NewRow, 27).Value = Worksheets("input").Range("B29").Value
Worksheets("Data").Cells(NewRow, 28).Value = Worksheets("input").Range("B30").Value
Worksheets("Data").Cells(NewRow, 29).Value = Worksheets("input").Range("B31").Value
Worksheets("Data").Cells(NewRow, 30).Value = Worksheets("input").Range("B32").Value
Worksheets("Data").Cells(NewRow, 31).Value = Worksheets("input").Range("B33").Value
Worksheets("Data").Cells(NewRow, 32).Value = Worksheets("input").Range("B34").Value
Worksheets("Data").Cells(NewRow, 33).Value = Worksheets("input").Range("B35").Value
Worksheets("Data").Cells(NewRow, 34).Value = Worksheets("input").Range("B36").Value
Worksheets("Data").Cells(NewRow, 35).Value = Worksheets("input").Range("B37").Value
'Range("B38") is a heading
Worksheets("Data").Cells(NewRow, 36).Value = Worksheets("input").Range("B39").Value
Worksheets("Data").Cells(NewRow, 37).Value = Worksheets("input").Range("B40").Value
Worksheets("Data").Cells(NewRow, 38).Value = Worksheets("input").Range("B41").Value
Worksheets("Data").Cells(NewRow, 39).Value = Worksheets("input").Range("B42").Value
Worksheets("Data").Cells(NewRow, 40).Value = Worksheets("input").Range("B43").Value
Worksheets("Data").Cells(NewRow, 41).Value = Worksheets("input").Range("B44").Value
Worksheets("Data").Cells(NewRow, 42).Value = Worksheets("input").Range("B45").Value
Worksheets("Data").Cells(NewRow, 43).Value = Worksheets("input").Range("B46").Value
Worksheets("Data").Cells(NewRow, 44).Value = Worksheets("input").Range("B47").Value
Worksheets("Data").Cells(NewRow, 45).Value = Worksheets("input").Range("B48").Value
Worksheets("Data").Cells(NewRow, 46).Value = Worksheets("input").Range("B49").Value
Worksheets("Data").Cells(NewRow, 47).Value = Worksheets("input").Range("B50").Value
Worksheets("Data").Cells(NewRow, 48).Value = Worksheets("input").Range("B51").Value
Worksheets("Data").Cells(NewRow, 49).Value = Worksheets("input").Range("B52").Value
Worksheets("Data").Cells(NewRow, 50).Value = Worksheets("input").Range("B53").Value
Worksheets("Data").Cells(NewRow, 51).Value = Worksheets("input").Range("B54").Value
Worksheets("Data").Cells(NewRow, 52).Value = Worksheets("input").Range("B55").Value
Sheets("Input").Select
Range("C2").Value = "Data added"
MsgBox "Data added", vbOKOnly, "Transfer Data"
Worksheets("input").Range("E1").Value = NewRow
Worksheets("input").Range("B3").Select
End Sub
Consider replacing the 52 lines transposing the data with one line inside a For/Next loop
Option Explicit
Sub add_to_table_sa_3()
Dim NewRow As Long, i as Long, arData
With Sheets("Input")
If .Range("F1").Value <> 0 Then
MsgBox "There are errors. No data has been added!", vbOKOnly, "Warning!"
Exit Sub
End If
arData = .Range("B3:B55").Value
NewRow = .Range("E1").Value + 1
End With
With Sheets("Data")
For i = 1 To 35
.Cells(NewRow, i) = arData(i, 1)
Next
'Range("B38") is a heading
For i = 37 To 65
.Cells(NewRow, i - 1) = arData(i, 1)
Next
'Range("B68") is a heading
For i = 67 To UBound(arData)
.Cells(NewRow, i - 2) = arData(i, 1)
Next
Sheet1.ComboBox1.ListFillRange = "'" & .Name & "'!A2:A" & NewRow
Sheet6.ComboBox2.ListFillRange = "'" & .Name & "'!A2:A" & NewRow
End With
With Sheets("Input")
.Range("C2").Value = "Data added"
.Range("E1").Value = NewRow
.Activate
.Range("B3").Select
End With
MsgBox "Data added row " & NewRow, vbOKOnly, "Transfer Data"
End Sub
I am trying to copy the values of a date from the sheet "Create new Customer" to "Customer data" and every time the date format changes
strName = Sheets("Create_New_Customer").Cells(14, 4).Value
strAddress = Sheets("Create_New_Customer").Cells(15, 4).Value
strTown = Sheets("Create_New_Customer").Cells(16, 4).Value
strPostcode = Sheets("Create_New_Customer").Cells(17, 4).Value
strTel = Sheets("Create_New_Customer").Cells(18, 4).Value
strEmail = Sheets("Create_New_Customer").Cells(19, 4).Value
strEqMk = Sheets("Create_New_Customer").Cells(20, 4).Value
strEqMdl = Sheets("Create_New_Customer").Cells(21, 4).Value
strEqType = Sheets("Create_New_Customer").Cells(22, 4).Value
strEqCost = Sheets("Create_New_Customer").Cells(23, 4).Value
strRentalStartDate = Sheets("Create_New_Customer").Cells(24, 4).Value
strCond = Sheets("Create_New_Customer").Cells(25, 4).Value
strPayT = Sheets("Create_New_Customer").Cells(26, 4).Value
strMonthRentalCost = Sheets("Create_New_Customer").Cells(27, 4).Value
strPaymentMehtod = Sheets("Create_New_Customer").Cells(28, 4).Value
With Sheets("CustomersData")
.Cells(LastRow, 2).Value = strName
.Cells(LastRow, 3).Value = strAddress
.Cells(LastRow, 4).Value = strTown
.Cells(LastRow, 5).Value = strPostcode
.Cells(LastRow, 6).Value = strTel
.Cells(LastRow, 7).Value = strEmail
.Cells(LastRow, 8).Value = strEqMk
.Cells(LastRow, 9).Value = strEqMdl
.Cells(LastRow, 10).Value = strEqType
.Cells(LastRow, 11).Value = strEqCost
.Cells(LastRow, 12).Value = strRentalStartDate
.Cells(LastRow, 13).Value = strCond
.Cells(LastRow, 14).Value = strPayT
.Cells(LastRow, 15).Value = strMonthRentalCost
.Cells(LastRow, 16).Value = strPaymentMehtod
End With
I am trying to make a userform with checkboxes, combo boxes text input into the cells of the next row of the excel sheet. I've tried so many ways to make it work but it won't input:
Private Sub CommandButton1_Click()
Dim rowcount As Long
Dim ws As worksheet
Set ws = Worksheets("Raw Data")
rowcount = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row
With ws
.Cells(rowcount, 0).Value = Me.TextBox1.Value
.Cells(rowcount, 1).Value = Me.TextBox2.Value
.Cells(rowcount, 2).Value = Me.TextBox3.Value
.Cells(rowcount, 3).Value = Me.TextBox4.Value
.Cells(rowcount, 4).Value = Me.TextBox5.Value
.Cells(rowcount, 5).Value = Me.TextBox6.Value
.Cells(rowcount, 6).Value = Me.TextBox7.Value
.Cells(rowcount, 7).Value = Me.TextBox8.Value
.Cells(rowcount, 8).Value = Me.TextBox9.Value
.Cells(rowcount, 9).Value = Me.TextBox10.Value
.Cells(rowcount, 10).Value = Me.PNBox.Value
.Cells(rowcount, 11).Value = Me.ENBox.Value
.Cells(rowcount, 12).Value = Me.CheckBox4.Value
.Cells(rowcount, 13).Value = Me.CheckBox5.Value
.Cells(rowcount, 14).Value = Me.CheckBox6.Value
.Cells(rowcount, 15).Value = Me.CheckBox7.Value
.Cells(rowcount, 19).Value = Me.CheckBox11.Value
.Cells(rowcount, 20).Value = Me.CheckBox12.Value
.Cells(rowcount, 21).Value = Me.CheckBox13.Value
.Cells(rowcount, 22).Value = Me.CheckBox14.Value
I want to make each variable show up on the next column on the sheet and blanks or false items to stay blank.
I am trying to format an 'Ok' button so that all the information in my form fills in the next empty row in my data table. Here is what I have so far:
Private Sub OKButton_Click()
Dim emptyRow As Long
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer Information
Cells(emptyRow, 1).Value = BoatModelComboBox.Value
Cells(emptyRow, 2).Value = BoatIDTextBox.Value
Cells(emptyRow, 3).Value = NameofDefectComboBox.Value
Cells(emptyRow, 4).Value = InspectionAreaComboBox.Value
Cells(emptyRow, 5).Value = DateTextBox.Value
Cells(emptyRow, 6).Value = OccurenceTextBox.Value
Cells(emptyRow, 7).Value = DefectOriginComboBox.Value
If BoatCheckOptionButton1.Value = True Then
Cells(emptyRow, 8).Value = "TRUE"
Else
Cells(emptyRow, 8).Value = "FALSE"
End If
If TireKickOptionButton1.Value = True Then
Cells(emptyRow, 9).Value = "TRUE"
Else
Cells(emptyRow, 9).Value = "FALSE"
End If
Cells(emptyRow, 10).Value = TypeofInspectionComboBox.Value
Cells(emptyRow, 11).Value = MonthComboBox.Value
thanks for the help!
Try getting the empty row like this instead
emptyRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row + 1