I cant find out what is problem with this code. when I run it I got compile error for LRow. I would be grateful if you help. Thanks in advance.
Dim NameTxb As String
Dim DateTxb As Date
Dim WYSTxb As Date
Dim WYETxb As Date
Dim DivCmb As String
Dim PosCmb As String
Dim VacCmb As Integer
Dim Add1Cmb As Integer
Dim Add2Cmb As Integer
Dim MDB As Worksheet: Set MDB = ThisWorkbook.Worksheets("MainDataBase")
Dim LRow As Long: LRow = MDB.Cells(MDB.Rows.Count, "A").End(xlUp).Row
With Worksheets("MainDataBase").LRow
LRow.Offset(1, 0).Value = AddWorker.NameTxb.Value
LRow.Offset(0, 1).Value = AddWorker.DivCmb.Value
LRow.Offset(0, 2).Value = AddWorker.PosCmb.Value
LRow.Offset(0, 3).Value = AddWorker.DateTxb.Value
LRow.Offset(0, 4).Value = AddWorker.WYSTxb.Value
LRow.Offset(0, 5).Value = AddWorker.WYETxb.Value
LRow.Offset(0, 6).Value = AddWorker.VacCmb.Value
LRow.Offset(0, 7).Value = AddWorker.Add1Cmb.Value
LRow.Offset(0, 7).Value = AddWorker.Add2Cmb.Value
End With
End sub
With MDB
.Range("A" & LRow).Offset(1, 0).Value =
.Range("A" & LRow).Offset(0, 1).Value =
Lrow will just be a number, not the row. SO you need to say Worksheets("MainDataBase").row(lrow)
Related
I am using Excel 2007. I try to copy Unit-price from the Excel file-2 data to the Excel file-1 when certain columns data matching from file-1 with file-2.
Thanks for the helps & guidance.
My VBA Code:
Sub mySales()
Dim LastRow As Integer, i As Integer, erow As Integer, Pipe_Class As String, Pipe_Description As String, End_Type As String, Pipe_Size As String
Dim wbk As Workbook
strPriceFile = "C:\Temp\File-2.xlsx"
LastRow = ActiveSheet.Range(“A” & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
Pipe_Class = ""
Pipe_Description = ""
End_Type = ""
Pipe_Size = ""
Pipe_Class = ActiveSheet.Cells(i, 1).Value
Pipe_Description = ActiveSheet.Cells(i, 2).Value
End_Type = ActiveSheet.Cells(i, 3).Value
Pipe_Size = ActiveSheet.Cells(i, 4).Value
Set wbk = Workbooks.Open(strPriceFile)
Worksheets("SOR2").Select
If Cells(i, 1) = Pipe_Class And Cells(i, 2) = Pipe_Description And Cells(i, 3) = End_Type And Cells(i, 4) = Pipe_Size Then
Range(Cells(i, 12), Cells(i, 12)).Select
Selection.Copy
??? After Here how select my current file & paste ????????
Worksheets("SOR1").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 12).Select
ActiveSheet.Paste
ActiveWorkbook.Save
End If
Next i
ActiveWorkbook.Close
Application.CutCopyMode = False
End Sub
I haven't checked all your code, but I have refactored what you have in your question in an attempt to open the Workbook once and to assign proper objects so that you can keep track of what action is being applied to which worksheet.
Sub mySales()
Dim LastRow As Integer, i As Integer, erow As Integer
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim strPriceFile As String
Set wbDst = ActiveWorkbook
Set wsDst = ActiveSheet
strPriceFile = "C:\Temp\File-2.xlsx"
Set wbSrc = Workbooks.Open(strPriceFile)
Set wsSrc = wbSrc.Worksheets("SOR2")
LastRow = wsDst.Range("A" & wsDst.Rows.Count).End(xlUp).Row
erow = LastRow + 1
For i = 2 To LastRow
If wsSrc.Cells(i, 1).Value = wsDst.Cells(i, 1).Value And _
wsSrc.Cells(i, 2).Value = wsDst.Cells(i, 2).Value And _
wsSrc.Cells(i, 3).Value = wsDst.Cells(i, 3).Value And _
wsSrc.Cells(i, 4).Value = wsDst.Cells(i, 4).Value Then
wsSrc.Cells(i, 12).Copy wsDst.Cells(erow, 12)
erow = erow + 1 ' your current code would always copies to the same row,
' but I **think** you probably want to copy to the
' next row each time
End If
Next i
wbSrc.Close
If erow > LastRow + 1 Then
wbDst.Save
End If
wbDst.Close
End Sub
The code is completely untested but, even if it doesn't work, at least it should give you an idea of how you should be processing multiple workbooks and multiple worksheets.
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
I am trying to generate multiple Excel file from a list in excel. Below are the code i tried but got runtime error 70.
The excel i use are (which can be download here: https://drive.google.com/folderview?id=0B7u1K6cUEOzeWURZWWd3NjQ4R0k&usp=sharing)
1) BasicInvoice.xlsx
2) 2011.xlsx
Private Sub CommandButton1_Click()
Dim Name As String
Dim invoicenumber As Long
Dim r As Long
Dim path As String
Dim myfilename As String
lastrow = Sheets("1").Range("A" & Rows.Count).End(xlUp).Row
r = 2
For r = 2 To lastrow
Date = Sheets("1").Cells(r, 1).Value
invoicenumber = Sheets("1").Cells(r, 2).Value
Name = Sheets("1").Cells(r, 3).Value
Description = Sheets("1").Cells(r, 4).Value
Amount = Sheets("1").Cells(r, 5).Value
Workbooks.Open ("BasicInvoice.xlsx")
ActiveWorkbook.Sheets("BasicInvoice").Activate
ActiveWorkbook.Sheets("BasicInvoice").Range("E9").Value = Date
ActiveWorkbook.Sheets("BasicInvoice").Range("E10").Value = invoicenumber
ActiveWorkbook.Sheets("BasicInvoice").Range("B9").Value = Name
ActiveWorkbook.Sheets("BasicInvoice").Range("B16").Value = Description
ActiveWorkbook.Sheets("BasicInvoice").Range("E16").Value = Amount
path = "C:\invoices\"
ActiveWorkbook.SaveCopyAs Filename:=path & invoicenumber & ".xlsx"
myfilename = ActiveWorkbook.FullName
Application.DisplayAlerts = True
ActiveWorkbook.PrintOut copies:=1
ActiveWorkbook.Close SaveChanges:=False
nextrow:
Next r
End Sub
RunTime Error 70 indicates that you're unable to write to something write protected. What line are you getting the error on?
Check to make sure that C:/Invoices folder actually exists on your hard drive.
Below is a tidy up of your code while I'm here.
Private Sub CommandButton1_Click()
Dim wbInv As Workbook, wsInv As Worksheet
Dim wbSrc As Workbook, wsSrc As Worksheet
Dim lastrow As Long, r As Long
Dim path As String
Set wbSrc = ThisWorkbook
Set wsSrc = wbSrc.Sheets("1")
Set wbInv = Workbooks.Open("BasicInvoice.xlsx")
Set wsInv = wbInv.Sheets("BasicInvoice")
path = "C:\invoices\"
lastrow = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For r = 2 To lastrow
With wsInv
.Range("E9").Value = wsSrc.Cells(r, 1).Value
.Range("E10").Value = wsSrc.Cells(r, 2).Value
.Range("B9").Value = wsSrc.Cells(r, 3).Value
.Range("B16").Value = wsSrc.Cells(r, 4).Value
.Range("E16").Value = wsSrc.Cells(r, 6).Value
End With
With wbInv
.SaveCopyAs Filename:=path & wsInv.Range("E10").Value & ".xlsx"
.PrintOut copies:=1
End With
Next r
wbInv.Close SaveChanges = False
Application.ScreenUpdating = True
End Sub
I have two Workbooks where I need to compare ID's from the one where I write the script and to other one I need to access from the script.
I loop through all numbers in sheet and record each ID in "tmpFisNo". After that I make one loop for iterating through other Workbook's rows and compare them.
However, it says "Mismatch Error" in line For j = ws.Cells(9, 9).Value To ws.Cells(10, 9).Value
Dim i As Integer
Dim j As Integer
Dim tmpFisNo As String
Dim tmpFisNo2 As String
Dim wbThis As Workbook
Dim wbTarget As Workbook
Dim wbPath As String
Dim ws As Worksheet
Sub Dogrula_Click()
wbPath = Cells(8, 9).Value
Set wbThis = ActiveWorkbook
Set wbTarget = Workbooks.Open("2015_OCAK_MUTABAKAT_RAPORU")
Set ws = wbTarget.Sheets(2)
For i = Cells(5, 9).Value To Cells(6, 9).Value
tmpFisNo = Cells(i, 2).Text
For j = ws.Cells(9, 9).Value To ws.Cells(10, 9).Value
tmpFisNo2 = ws.Cells(j, 4).Text
If tmpFisNo = tmpFisNo2 Then
Cells(i, 7).Value = 1
End If
Next j
Next i
End Sub
Try
Dim i As Long
Dim j As Long
Dim tmpFisNo As String
Dim tmpFisNo2 As String
Dim wbThis As Workbook
Dim wbTarget As Workbook
Dim wbPath As String
Dim ws As Worksheet
Sub Dogrula_Click()
wbPath = Cells(8, 9).Value
Set wbThis = ActiveWorkbook
Set wbTarget = Workbooks.Open("2015_OCAK_MUTABAKAT_RAPORU")
Set ws = wbTarget.Sheets(2)
For i = Cells(5, 9).Value To Cells(6, 9).Value
tmpFisNo = Cells(i, 2).Text
dim a as Long, b as Long
a = CLng(ws.Cells(9, 9).Value)
b = CLng(ws.Cells(10, 9).Value)
For j = a To b
tmpFisNo2 = ws.Cells(j, 4).Text
If tmpFisNo = tmpFisNo2 Then
Cells(i, 7).Value = 1
End If
Next j
Next i
End Sub
If it gives you an error on the CLngs then it's because you have some values in the spreadsheet in cells (9,9) or (10,9) which aren't integers
I would also recommend using Long instead of Integer - you can't reach all the cells in the worksheet using Integer (even for the old versions of Excel)
I would like to change some Book2 value with respect to Book1's value.
Macro code in Book1:
Dim i As Integer
Dim k As Integer
k = Range("Z1")
For i = 1 To k
If Cells(i, 22).Value = "Yes" Then
Windows("Book2").Activate
Cells(i, 11) = ""
Cells(i, 13) = ""
End If
Next i
As commented, you can try re-writing your code like this:
Dim i As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Workbooks("Book1").Sheets("Sheet1") '~~> change sheet name to suit
Set ws2 = Workbooks("Book2").Sheets("Sheet1")
With ws1
For i = 1 to .Range("Z1").Value
If .Cells(i, 22).Value = "Yes" Then
ws2.Cells(i, 11).Value = ""
ws2.Cells(i, 13).Value = ""
End If
Next
End With