Copy cell values to different Workbook - vba

Firstly, let me apologise if this question has already been answered somewhere else. I had a good look but couldn't find anything that would help me.
Secondly, I'm sure there is a far more simple way to do this but I'm very new the VBA and I'm just trying to teach myself as I go along.
Ok, so I have a sheet at the end of my workbook that compiles information from the previous sheet and I want to copy those values that are all in row 2 to another workbook that we have a network drive.
I've managed to get this to work on the same sheet but not to another workbook (without using a userform).
It comes back with the error 'Invalid Qualifier' for the line
Cells(emptyRow, 1.Value - DateRaised.Value
Here is my code below,
Sub CommandButton1_Click()
Dim emptyRow As Long
Dim DateRaised As Long
Dim CustomerName As String
Dim SiteAddress As String
Dim CallReason As String
Dim CustomerOrderNo As Long
Dim InvoiceNo As Long
Dim CovernoteNo As Long
Dim Findings As String
Dim ProductType As String
Dim Supplier As String
Dim Attempts As Long
Dim Condition As String
Dim DateClosed As Long
Dim CreditGiven As String
Dim CreditValue As Long
Dim IssueDays As Long
Dim Comments As String
DateRaised = Cells(2, "A").Value
CustomerName = Cells(2, "B").Value
SiteAddress = Cells(2, "C").Value
CallReason = Cells(2, "D").Value
CustomerOrderNo = Cells(2, "F").Value
InvoiceNo = Cells(2, "G").Value
CovernoteNo = Cells(2, "H").Value
Findings = Cells(2, "I").Value
ProductType = Cells(2, "J").Value
Supplier = Cells(2, "K").Value
Attempts = Cells(2, "L").Value
Condition = Cells(2, "M").Value
DateClosed = Cells(2, "N").Value
CreditGiven = Cells(2, "O").Value
CreditValue = Cells(2, "P").Value
IssueDays = Cells(2, "Q").Value
Comments = Cells(2, "R").Value
Dim WrkBk As Workbook
Dim WrkSht As Worksheet
Set WrkBk = Workbooks.Open("R:\6024 Onsite\COVER NOTE WORKFLOW\Database\Covernote Databse.xlsx")
Set WrkSht = WrkBk.Sheets("Covernote Database")
WrkSht.Activate
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(emptyRow, 1).Value = DateRaised.Value
Cells(emptyRow, 2).Value = CustomerName.Value
Cells(emptyRow, 3).Value = SiteAddress.Value
Cells(emptyRow, 4).Value = CallReason.Value
Cells(emptyRow, 5).Value = CustomerOrderNo.Value
Cells(emptyRow, 6).Value = InvoiceNo.Value
Cells(emptyRow, 7).Value = CovernoteNo.Value
Cells(emptyRow, 8).Value = Findings.Value
Cells(emptyRow, 9).Value = ProductType.Value
Cells(emptyRow, 10).Value = Supplier.Value
Cells(emptyRow, 11).Value = Attemps.Value
Cells(emptyRow, 12).Value = Condition.Value
Cells(emptyRow, 13).Value = DateClosed.Value
Cells(emptyRow, 14).Value = CreditGiven.Value
Cells(emptyRow, 15).Value = CreditValue.Value
Cells(emptyRow, 16).Value = IssueDays.Value
Cells(emptyRow, 17).Value = Comments.Value
WrkBk.Close (SaveChanges = False)
End Sub
If anyone can point me in the right direction I'd be a very happy man.

it's because you're attempting to treat value types (like String and Long) variables as if they were reference type (objects) ones calling their Value property:
Cells(emptyRow, 1).Value = DateRaised.Value
while you can't (unless you use User Defined Types): value type variables can be only accessed as they are:
Cells(emptyRow, 1).Value = DateRaised
but you can simply code like follows:
Option Explicit
Sub CommandButton1_Click()
Dim emptyRow As Long
Dim curSht As Worksheet
Set curSht = ActiveSheet
With Workbooks.Open("R:\6024 Onsite\COVER NOTE WORKFLOW\Database\Covernote Databse.xlsx").Sheets("Covernote Database")
emptyRow = WorksheetFunction.CountA(.Range("A:A")) + 1
.Cells(emptyRow, 1).Resize(, 17).value = curSht.Cells(2, 1).Resize(, 17).value '<-- paste values from originally opened sheet range A2:Q2
End With
ActiveWorkbook.Close SaveChanges:=False
End Sub

Related

Using rangefind

I have three sheets, sheet S, Sheet P and Sheet Data.
I first copy the column of Sheet S to Sheet Data. Then in column E of sheet Data, I look for the ID. The ID In column E of data sheet, matches with the column A of P sheet, then I copy the corresponding ID.
The problem here is the Sheet data contains 214 rows, while sheet P contains 1110.
while comparing the ID, there are two different ID from row 870 and 871, which are not copied, even though they are same.
Could someone guide what could be the reason ?
Sub lookup()
Dim lLastrow, totalrows As Long
Dim rng As Range
Dim i As Long
'Copy lookup values from S to Data
With Sheets("S")
lLastrow = .Cells(.Rows.count, 1).End(xlUp).Row
.Range("P5:P" & lLastrow).Copy Destination:=Sheets("Data").Range("E5")
.Range("G5:G" & lLastrow).Copy Destination:=Sheets("Data").Range("H5")
End With
totalrows = Sheets("P").Cells(Sheets("P").Rows.count, "A").End(xlUp).Row
For i = 5 To lLastrow
'Search for the value on P_APQP
With Sheets("P")
Set rng = .Columns(1).Find(Sheets("Data").Cells(i, 5).Value & "*", lookat:=xlWhole)
End With
'If it is found put its value on the destination sheet
If Not rng Is Nothing Then
With Sheets("Data")
.Cells(i, 6).Value = rng.Value
.Cells(i, 1).Value = rng.Offset(0, 1).Value
.Cells(i, 2).Value = rng.Offset(0, 2).Value
.Cells(i, 3).Value = rng.Offset(0, 3).Value
.Cells(i, 4).Value = rng.Offset(0, 9).Value
.Cells(i, 9).Value = rng.Offset(0, 10).Value
.Cells(i, 13).Value = rng.Offset(0, 6).Value
.Cells(i, 14).Value = rng.Offset(0, 5).Value
.Cells(i, 15).Value = rng.Offset(0, 4).Value
.Cells(i, 16).Value = rng.Offset(0, 8).Value
End With
End If
Next i
End Sub
I'll post the whole code. I also made an adjustment to your first line of declarations - as you had it, only totalrows was being declared as Long. You have to spell each one out I'm afraid.
Sub lookup()
Dim lLastrow As Long, totalrows As Long
Dim rng As Range
Dim i As Long
With Sheets("S")
lLastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("P5:P" & lLastrow).Copy Destination:=Sheets("Data").Range("E5")
.Range("G5:G" & lLastrow).Copy Destination:=Sheets("Data").Range("H5")
End With
totalrows = Sheets("P").Cells(Sheets("P").Rows.Count, "A").End(xlUp).Row
For i = 5 To lLastrow
'Search for the value on P_APQP
With Sheets("P")
'amended below
Set rng = .Columns(1).Find(Trim(Sheets("Data").Cells(i, 5).Value) & "*", lookat:=xlWhole)
End With
'If it is found put its value on the destination sheet
If Not rng Is Nothing Then
With Sheets("Data")
.Cells(i, 6).Value = rng.Value
.Cells(i, 1).Resize(, 3).Value = rng.Offset(0, 1).Value
.Cells(i, 2).Value = rng.Offset(0, 2).Value
.Cells(i, 3).Value = rng.Offset(0, 3).Value
.Cells(i, 4).Value = rng.Offset(0, 9).Value
.Cells(i, 9).Value = rng.Offset(0, 10).Value
.Cells(i, 13).Value = rng.Offset(0, 6).Value
.Cells(i, 14).Value = rng.Offset(0, 5).Value
.Cells(i, 15).Value = rng.Offset(0, 4).Value
.Cells(i, 16).Value = rng.Offset(0, 8).Value
End With
End If
Next i
End Sub

vba For each loop writing to the same row

I wanted to reach out on a concern i am getting with with my loop. i need to copy all trainee data in the class list sheet from rows 13 on and put it into a roster registry sheet same workbook. however the code i wrote initially is giving me and error when i use .Range(i, 1) so i changed it to .Cells. Main concern is that the code writes the data into the roster registry sheet but only the last trainee data.
Option Explicit
Sub ExportcReg()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wbk1 As Workbook
Dim s1, cReg As Worksheet
Dim x, i, FinalRow As Long
Dim thisvalue As String
Set wbk1 = Workbooks.Open(ThisWorkbook.Worksheets("Info").Range("A1").Value)
Set s1 = wbk1.Sheets("ClassRegistry")
Set cReg = ThisWorkbook.Worksheets("Class Registry")
With cReg
' Find the last row of data in Column "A"
FinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column A
thisvalue = .Cells(x, 1).Value
If thisvalue <> "" Then
i = s1.Cells(s1.Rows.Count, 1).End(xlUp).Row + 1
s1.Cells(i, 1).Value = thisvalue
s1.Cells(i, 2).Value = .Cells(x, 2).Value
s1.Cells(i, 3).Value = .Cells(x, 3).Value
s1.Cells(i, 4).Value = .Cells(x, 4).Value
s1.Cells(i, 5).Value = .Cells(x, 5).Value
s1.Cells(i, 6).Value = .Cells(x, 5).Value
s1.Cells(i, 7).Value = .Cells(x, 7).Value
s1.Cells(i, 8).Value = .Cells(x, 8).Value
s1.Cells(i, 9).Value = .Cells(x, 9).Value
s1.Cells(i, 10).Value = .Cells(x, 10).Value
s1.Cells(i, 11).Value = .Cells(x, 11).Value
s1.Cells(i, 12).Value = .Cells(x, 12).Value
s1.Cells(i, 13).Value = .Cells(x, 13).Value
s1.Cells(i, 14).Value = .Cells(x, 14).Value
s1.Cells(i, 15).Value = .Cells(x, 15).Value
s1.Cells(i, 16).Value = .Cells(x, 16).Value
s1.Cells(i, 17).Value = .Cells(x, 17).Value
s1.Cells(i, 18).Value = .Cells(x, 18).Value
End If
Next x
End With
wbk1.Close savechanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You have too much logical and technical errors in your code which I cannot explain line by line. Besides you can achieve your goal with less coding. Maybe what you need is a working code to understand how things work. Take a look at this:
Sub CListtoRReg()
'From Class List to Roster Registry
Dim ws1 As Worksheet: Set ws1 = Worksheets("Class List")
Dim ws2 As Worksheet: Set ws2 = Worksheets("Roster Registry")
Dim i, j As Long
For i = 13 To ws1.Cells(1, 1).End(xlDown).Row
ws2.Cells(1, 1).End(xlDown).Offset(1) = ws1.Range("C2").Value
For j = 2 To 11
ws2.Cells(1, 1).End(xlDown).Offset(0, j - 1) = ws1.Cells(i, j - 1).Value
Next j
Next i
End Sub

Having trouble using designer and inputng VBA Code

Can someone help me get my userform to submit into this table from cal worksheet?
Private Sub cmdbutton_submitform_Click()
Dim emptyRow As Long
'Make Sheet2 active
Sheet2.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information
Cells(emptyRow, 1).Value = txtbox_number.Value
Cells(emptyRow, 2).Value = txtbox_rank.Value
Cells(emptyRow, 3).Value = txtbox_Name.Value
Cells(emptyRow, 4).Value = txtbox_height.Value
Cells(emptyRow, 5).Value = txtbox_weight.Value
Cells(emptyRow, 6).Value = txtbox_right_rm.Value
Cells(emptyRow, 7).Value = txtbox_left_rm.Value
End Sub
I think you are getting confused with sheet codenames and sheet names (see this). Try
Private Sub cmdbutton_submitform_Click()
Dim emptyRow As Long
With Worksheets("Sheet2")
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(.Range("A:A")) + 1
'Transfer information
.Cells(emptyRow, 1).Value = txtbox_number.Value
.Cells(emptyRow, 2).Value = txtbox_rank.Value
.Cells(emptyRow, 3).Value = txtbox_Name.Value
.Cells(emptyRow, 4).Value = txtbox_height.Value
.Cells(emptyRow, 5).Value = txtbox_weight.Value
.Cells(emptyRow, 6).Value = txtbox_right_rm.Value
.Cells(emptyRow, 7).Value = txtbox_left_rm.Value
End With
End Sub
Using Worksheet.Activate method likely loses the parent form reference that is required to correctly get the text box data from the user form. Within this Private Sub you should be able to reference Sheet2 by its Worksheet .CodeName property and use Me to reference the user form as the parent of the text boxes.
Private Sub cmdbutton_submitform_Click()
Dim emptyRow As Long
'Reference Sheet2 by CodeName as the parent worksheet of the .Cells
With Sheet2
'Determine emptyRow
emptyRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
'Transfer information
.Cells(emptyRow, 1).Value = Me.txtbox_number.Value
.Cells(emptyRow, 2).Value = Me.txtbox_rank.Value
.Cells(emptyRow, 3).Value = Me.txtbox_Name.Value
.Cells(emptyRow, 4).Value = Me.txtbox_height.Value
.Cells(emptyRow, 5).Value = Me.txtbox_weight.Value
.Cells(emptyRow, 6).Value = Me.txtbox_right_rm.Value
.Cells(emptyRow, 7).Value = Me.txtbox_left_rm.Value
End With
End Sub
I found it a little odd that you were identifying the worksheet with a Worksheet .CodeName property rather than a Worksheet .Name property. I've included a couple of links to make sure you are using the naming conventions correctly. In any event, I've use a With ... End With statement to avoid repeatedly reidentifying the parent worksheet.

How to fix Runtime Error "91" in Excel

I have created a userform to enter data into worksheets for me. I am trying to code it where it will put the information into a selected worksheet. I have a combobox where I can select the sheet I want it to put the info in. I am trying to set the variable ws to the combobox value and I get a runtime error '91' and it says "object variable or with block not set". The code I am having problems with is below.
Private Sub bttn_Submit_Click()
Dim iRow As Long
Dim ws As Worksheet
'set the variable for the worksheet
ws = ComboBox1.Value
'find first empty row in database
iRow = Columns("A").Find("*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a date
If Trim(Me.txt_Date.Value) = "" Then
Me.txt_Date.SetFocus
MsgBox "Please enter a Date"
Exit Sub
End If
'copy the data to the database
'use protect and unprotect lines,
' with your password
' if worksheet is protected
With ws
' .Unprotect Password:="password"
.Cells(iRow, 1).Value = Me.txt_Date.Value
.Cells(iRow, 2).Value = Me.txt_Invoice.Value
.Cells(iRow, 3).Value = Me.txt_Mileage.Value
.Cells(iRow, 5).Value = Me.CheckBox_Oil_Filter
.Cells(iRow, 7).Value = Me.CheckBox_Air_Filter
.Cells(iRow, 9).Value = Me.CheckBox_Primary_Fuel_Filter
.Cells(iRow, 11).Value = Me.CheckBox_Secondary_Fuel_Filter
.Cells(iRow, 13).Value = Me.CheckBox_Transmission_Filter
.Cells(iRow, 15).Value = Me.CheckBox_Transmission_Service
.Cells(iRow, 17).Value = Me.CheckBox_Wiper_Blades
.Cells(iRow, 19).Value = Me.CheckBox_Rotation_Rotated
.Cells(iRow, 21).Value = Me.CheckBox_New_Tires
.Cells(iRow, 23).Value = Me.CheckBox_Differential_Service
.Cells(iRow, 25).Value = Me.CheckBox_Battery_Replacement
.Cells(iRow, 27).Value = Me.CheckBox_Belts
.Cells(iRow, 29).Value = Me.CheckBox_Lubricate_Chassis
.Cells(iRow, 30).Value = Me.CheckBox_Brake_Fluid
.Cells(iRow, 31).Value = Me.CheckBox_Coolant_Check
.Cells(iRow, 32).Value = Me.CheckBox_Power_Steering_Check
.Cells(iRow, 33).Value = Me.CheckBox_A_Transmission_Check
.Cells(iRow, 34).Value = Me.CheckBox_Washer_Fluid_Check
' .Protect Password:="password"
End With
'clear the data
Me.txt_Date.Value = ""
Me.txt_Invoice.Value = ""
Me.txt_Mileage.Value = ""
Me.txt_Date.SetFocus
End Sub
I take your piece of code and explain you the inconsistency:
Dim ws As Worksheet
ws = ComboBox1.Value
The first line of code is declaring ws as a Worksheet object. Objects in VBA need the keyword Set to be set, and of course the data type needs to match the declaration.
On the other hand, in the second statement you're setting ws as ComboBox1.Value, which is a type String. So:
1) The reason why you get the error is that ws is a variable that, because of its declaration, expects to get a Worksheet object but you're instead trying to cast a String in it;
2) What you probably want to do is to have in ws the Worksheet object whose name is the ComboBox1.Value; this, in terms of code, should be written as follows:
Set ws = ThisWorkbook.Sheets(ComboBox1.Value)
You only need to replace the line ws = ComboBox1.Value with the line above.
Pay attention, in general: if you declare a variable of type X, it will always be able to cast only a type X object, unless you don't declare it at all (very bad practice, you would get errors after).

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