Hi All, I need a bit of help, I have some code where when the user clicks a button it sends an email out. At the bottom of this code there is a part of the code where excel will open another workbook and add data from certain cells. The problem I have is when the Cell data is different, the code is meant to add a new line, but all it seems to day is over write what was previously there.
Please see the Code below
Thank you in advance.
Please see the Code below
Thank you in advance.
VBA Code:
Dim LTWb As Workbook
Dim LTWs As Worksheet
Dim CRM As Range
Dim FM As Range
Dim LIQB As Workbook
Dim CR As Worksheet
Dim QB As Worksheet
Dim CName As Range
Dim data As Worksheet
Dim Account As Range
Dim Labelty As Range
Dim SPref As Range
Dim CertNumbers As Range
Dim idRegion As Range
Set LIQB = ActiveWorkbook
Set LR = Sheets("Label Quote Review")
Set QB = Sheets("Quote builder")
Set data = Sheets("Data")
Set CRM = LR.Range("I4")
Set FM = LR.Range("I5")
Set CName = LR.Range("I3")
Set Account = LR.Range("I12")
Set Labelty = LR.Range("K12")
Set SPref = LR.Range("I9")
Set CertNumbers = data.Range("A50")
'Opening the PO List and counting how many rows of data there are
Set LTWb = Workbooks.Open("W:\WCL\Certification\Dashboards\Label Quote Tracker.xlsx")
Application.Visible = False
Set LTWs = Worksheets("Sheet1")
RowCount = LTWs.Range("A1").CurrentRegion.Rows.Count
On Error Resume Next
'Check if the ID already has a PO on the list
Set idRegion = Range("A2:A" & RowCount)
Set cell = idRegion.Find(what:=CRM, LookAt:=xlWhole, SearchFormat:=False)
If cell Is Nothing Then 'if there is no ID on the list already then add a new line...
With Worksheets("Sheet1").Range("A1")
.Offset(0, 0) = CRM
.Offset(0, 1) = FM
.Offset(0, 2) = CName
.Offset(0, 3) = Account
.Offset(0, 4) = Labelty
.Offset(0, 5) = SPref
.Offset(0, 6) = CertNumbers
End With
MsgBox "Label Quote Added to Tracker", vbInformation
LTWb.Save
LTWb.Close
Else 'ask whether or not to replace the existing data
cont = MsgBox("There is already a Label Quote for this opportunity on the Label Quote Tracker. Click OK to overwrite with new information, click Cancel to exit", vbOKCancel)
If cont = vbOK Then 'replace the PO list line with this new info
cell.EntireRow.ClearContents
With cell
.Offset(0, 0) = CRM
.Offset(0, 1) = FM
.Offset(0, 2) = CName
.Offset(0, 3) = Account
.Offset(0, 4) = Labelty
.Offset(0, 5) = SPref
.Offset(0, 6) = CertNumbers
End With
MsgBox "Details replaced on Tracker", vbInformation
Else
If cont = vbCancel Then 'just close without saving
LTWb.Close False
Application.ScreenUpdating = True
Application.ScreenUpdating = True
Application.Visible = True
Exit Sub
End If
End If
End If
LTWb.Save
LTWb.Close
Application.ScreenUpdating = True
Application.Visible = True
End Sub
