2no. Excel programming issues
- or -
Post a project like this4431
$$
- Posted:
- Proposals: 3
- Remote
- #120867
- Awarded
Description
Experience Level: Intermediate
1st Issue: -
Following code upon click of a button ('Test Transfer Data', top right hand corner of BPC Form), does the following: -
1) Opens up another excel file 'BPC Data Form'
2) Looks in Column A (Sheet2) for a corresponding match from the Archdiocese No (Ref J11) on the BPC Form
3) Goes to the next blank cell in that row, and is then supposed to copy/paste the DFCAmount (Ref J138) from the BPC Form.
All works fine but wont copy/paste beyond what row above has in it.
Think it has something to do with my (EndColumn =) bit of code
Code:
Private Sub CommandButton19_Click()
Dim DestBook As Workbook, SrcBook As Workbook
Application.ScreenUpdating = False
Set SrcBook = ThisWorkbook
Set DestBook = Workbooks.Open("C:\Users\stevet\BPC Data Form.xlsx")
Dim rng As Range, c As Range, cfind As Range
', EndColumn As Range
On Error Resume Next
With Worksheets("BPC Form")
Set rng = Range("ArchdioceseNo")
For Each c In rng
EndColumn = Worksheets(DestBook.Worksheets(2).Name).Cells(2, 256).End(xlToLeft).Column
With Worksheets(DestBook.Worksheets(2).Name)
Set cfind = .Columns("A:A").Cells.Find _
(what:=c.Value, Lookat:=xlWhole)
If cfind Is Nothing Then GoTo line1
.Cells(cfind.Row, EndColumn) = [DFCAmount]
End With 'sheet2
line1:
Next c
2nd Issue: -
Following code upon click of a button ('Transfer Data', top right hand corner of BPC Form), does the following: -
1) Opens up another excel file 'BPC Data Form'
2) Looks in Column A (Sheet1) for a corresponding match from the Arch No (Ref G11) on the BPC Form. Or goes to a blank row if Arch No doesn't exist.
3) Copy and pastes select information from the BPC Form into BPC Data Form.
' KEEP
' KEEP
'Sub CopyData()
For example, in Excel 2007-2010, this will fail if the ActiveWorkbook is not an xlsm file
'ActiveWorkbook.SaveAs "C:\ron.xlsm"
This code will always work
'ActiveWorkbook.SaveAs "C:\ron.xlsm", FileFormat:=52
' 52 = xlOpenXMLWorkbookMacroEnabled = xlsm (with macro's in 2007-2010
Dim OutApp As Object
Dim OutMail As Object
Dim Ref As String
Dim Ref1 As String
Dim Ref2 As String
Dim Email As String
'If Me.range("Password").Value <> "roberts" Then
If TextBox1.Text <> "roberts" Then
MsgBox "Incorrect Password or Password Missing", vbInformation
ElseIf Me.Range("ArchNo").Value = "" And _
Me.Range("J4").Value = "ü" And _
Me.Range("J5").Value = "û" Then
ActiveSheet.Unprotect
MsgBox "Archdiocese No. required before data transfer can be carried out", vbInformation
TextBox1.Value = ""
ElseIf TextBox1.Text Like "*" And _
Me.Range("J4").Value = "ü" And _
Me.Range("J5").Value = "û" Then
ActiveSheet.Unprotect
TextBox1.Value = ""
ActiveWorkbook.Save
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Ref = Me.Range("AreaSurveyor")
Ref1 = Me.Range("ProjectManager")
Ref2 = Me.Range("School")
Email = Me.Range("Email")
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = Email
.CC = ""
.BCC = ""
.Subject = Ref2
.Body = Ref1 & vbNewLine & vbNewLine & "BPC Stage 1 form attached ready for Stage2 completion" & vbNewLine & vbNewLine & "Regards" & vbNewLine & "Form will now go forward for approval/consideration at next sub-committe agenda" & vbNewLine & vbNewLine & "Steve Roberts"
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Dim DestBook As Workbook, SrcBook As Workbook
Application.ScreenUpdating = False
Set SrcBook = ThisWorkbook
On Error Resume Next
'Set myshell = C:\Users\stevet\BPC1.pdf)
Set DestBook = Workbooks.Open("C:\Users\stevet\BPC Data Form.xlsx")
' Get Row number to Copy new data to
EndRow = DestBook.Sheets("BPC Projects Data").Range("A65536").End(xlUp).Row + 1
'EndRow = DestBook.Sheets("Sheet1").Cells(65536, 1).End(xlUp).Row + 1
' Select the current data area.
DestBook.Worksheets(1).Range("A" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("ArchNo").Value
DestBook.Worksheets(1).Range("B" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("DfESNo").Value
DestBook.Worksheets(1).Range("C" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("LEA").Value
DestBook.Worksheets(1).Range("D" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("ArchdioceseNo").Value
DestBook.Worksheets(1).Range("E" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("School").Value
DestBook.Worksheets(1).Range("M" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("AreaSurveyor").Value
DestBook.Worksheets(1).Range("F" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("ProjectTitle").Value
DestBook.Worksheets(1).Range("R" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("B114").Value
'DestBook.Worksheets(1).Range("H" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("ProjectManager").Value
DestBook.Worksheets(1).Range("N" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("ProjectManager").Value
Application.CutCopyMode = False
DestBook.Save
'Transfer Data After Receiving Stage 2 and Email Response Back
ElseIf Me.Range("ArchNo").Value Like "*" And _
Me.Range("K4").Value = "*" And _
Me.Range("K5").Value = "ü" Then
ActiveSheet.Unprotect
'Me.range("Password").Value = Null
TextBox1.Value = ""
'ActiveWorkbook.Save
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Ref = Me.Range("AreaSurveyor")
Ref1 = Me.Range("ProjectManager")
Ref2 = Me.Range("School")
Email = Me.Range("Email")
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = Email
.CC = ""
.BCC = ""
.Subject = Ref2
.Body = Ref1 & vbNewLine & vbNewLine & "Thank for the submission of the Stage 2 BPC Form." & vbNewLine & vbNewLine & "Form will now go forward for approval/consideration at next sub-committe agenda" & vbNewLine & vbNewLine & "Steve Roberts"
'.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'Dim DestBook As Workbook, SrcBook As Workbook
Application.ScreenUpdating = False
Set SrcBook = ThisWorkbook
Set DestBook = Workbooks.Open("C:\Users\stevet\BPC Data Form.xlsx")
Dim rng As Range, c As Range, cfind As Range
On Error Resume Next
With Worksheets("BPC Form")
'Set rng = SrcBook.Sheets("BPC Form").Range("ArchNo").Value
Set rng = Range("ArchNo")
For Each c In rng
'With Worksheets = DestBook.Worksheets(1).Range("A" & EndRow)
With Worksheets(DestBook.Worksheets(1).Name)
Set cfind = .Columns("A:A").Cells.Find _
(what:=c.Value, Lookat:=xlWhole)
If cfind Is Nothing Then GoTo line1
.Cells(cfind.Row, 1) = [ArchNo]
.Cells(cfind.Row, 2) = [DfESNo]
.Cells(cfind.Row, 3) = [LEA]
.Cells(cfind.Row, 4) = [ArchdioceseNo]
.Cells(cfind.Row, 5) = [School]
.Cells(cfind.Row, 13) = [AreaSurveyor]
.Cells(cfind.Row, 6) = [ProjectTitle]
.Cells(cfind.Row, 18) = [B114]
.Cells(cfind.Row, 14) = [ProjectManager]
.Cells(cfind.Row, 15) = [TopContractor]
.Cells(cfind.Row, 16) = [Stage2BuildingCosts]
.Cells(cfind.Row, 17) = [Stage2Total]
'cfind.Copy Worksheets("sheet1").Cells(Rows.Count, "A").End(x1Up).Offest(1, 0)
End With 'sheet1
line1:
Next c
Application.CutCopyMode = False
End With 'BPC Form
End If
'ActiveSheet.Protect Contents:=True
I would like howveer for the above code to do the following also: -
- save the BPC Form as a PDF File.
- Paste/instert, resize and lock it into into cell of Row 'v' of the BPC Data Form as an attachment.
My 'Attach Drawing' buttons at the bottom of the form sort of do this as an example of how I want it to resize and lock it to the cell so assuming some of this code would apply to the above.
Have tried to attach files but not uploading. If you would like to contact me on no. below I could email them to you.
I would also require the changes making before Thursday 24th Feb 2012.
Kind Regards
Steve
Following code upon click of a button ('Test Transfer Data', top right hand corner of BPC Form), does the following: -
1) Opens up another excel file 'BPC Data Form'
2) Looks in Column A (Sheet2) for a corresponding match from the Archdiocese No (Ref J11) on the BPC Form
3) Goes to the next blank cell in that row, and is then supposed to copy/paste the DFCAmount (Ref J138) from the BPC Form.
All works fine but wont copy/paste beyond what row above has in it.
Think it has something to do with my (EndColumn =) bit of code
Code:
Private Sub CommandButton19_Click()
Dim DestBook As Workbook, SrcBook As Workbook
Application.ScreenUpdating = False
Set SrcBook = ThisWorkbook
Set DestBook = Workbooks.Open("C:\Users\stevet\BPC Data Form.xlsx")
Dim rng As Range, c As Range, cfind As Range
', EndColumn As Range
On Error Resume Next
With Worksheets("BPC Form")
Set rng = Range("ArchdioceseNo")
For Each c In rng
EndColumn = Worksheets(DestBook.Worksheets(2).Name).Cells(2, 256).End(xlToLeft).Column
With Worksheets(DestBook.Worksheets(2).Name)
Set cfind = .Columns("A:A").Cells.Find _
(what:=c.Value, Lookat:=xlWhole)
If cfind Is Nothing Then GoTo line1
.Cells(cfind.Row, EndColumn) = [DFCAmount]
End With 'sheet2
line1:
Next c
2nd Issue: -
Following code upon click of a button ('Transfer Data', top right hand corner of BPC Form), does the following: -
1) Opens up another excel file 'BPC Data Form'
2) Looks in Column A (Sheet1) for a corresponding match from the Arch No (Ref G11) on the BPC Form. Or goes to a blank row if Arch No doesn't exist.
3) Copy and pastes select information from the BPC Form into BPC Data Form.
' KEEP
' KEEP
'Sub CopyData()
For example, in Excel 2007-2010, this will fail if the ActiveWorkbook is not an xlsm file
'ActiveWorkbook.SaveAs "C:\ron.xlsm"
This code will always work
'ActiveWorkbook.SaveAs "C:\ron.xlsm", FileFormat:=52
' 52 = xlOpenXMLWorkbookMacroEnabled = xlsm (with macro's in 2007-2010
Dim OutApp As Object
Dim OutMail As Object
Dim Ref As String
Dim Ref1 As String
Dim Ref2 As String
Dim Email As String
'If Me.range("Password").Value <> "roberts" Then
If TextBox1.Text <> "roberts" Then
MsgBox "Incorrect Password or Password Missing", vbInformation
ElseIf Me.Range("ArchNo").Value = "" And _
Me.Range("J4").Value = "ü" And _
Me.Range("J5").Value = "û" Then
ActiveSheet.Unprotect
MsgBox "Archdiocese No. required before data transfer can be carried out", vbInformation
TextBox1.Value = ""
ElseIf TextBox1.Text Like "*" And _
Me.Range("J4").Value = "ü" And _
Me.Range("J5").Value = "û" Then
ActiveSheet.Unprotect
TextBox1.Value = ""
ActiveWorkbook.Save
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Ref = Me.Range("AreaSurveyor")
Ref1 = Me.Range("ProjectManager")
Ref2 = Me.Range("School")
Email = Me.Range("Email")
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = Email
.CC = ""
.BCC = ""
.Subject = Ref2
.Body = Ref1 & vbNewLine & vbNewLine & "BPC Stage 1 form attached ready for Stage2 completion" & vbNewLine & vbNewLine & "Regards" & vbNewLine & "Form will now go forward for approval/consideration at next sub-committe agenda" & vbNewLine & vbNewLine & "Steve Roberts"
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Dim DestBook As Workbook, SrcBook As Workbook
Application.ScreenUpdating = False
Set SrcBook = ThisWorkbook
On Error Resume Next
'Set myshell = C:\Users\stevet\BPC1.pdf)
Set DestBook = Workbooks.Open("C:\Users\stevet\BPC Data Form.xlsx")
' Get Row number to Copy new data to
EndRow = DestBook.Sheets("BPC Projects Data").Range("A65536").End(xlUp).Row + 1
'EndRow = DestBook.Sheets("Sheet1").Cells(65536, 1).End(xlUp).Row + 1
' Select the current data area.
DestBook.Worksheets(1).Range("A" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("ArchNo").Value
DestBook.Worksheets(1).Range("B" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("DfESNo").Value
DestBook.Worksheets(1).Range("C" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("LEA").Value
DestBook.Worksheets(1).Range("D" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("ArchdioceseNo").Value
DestBook.Worksheets(1).Range("E" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("School").Value
DestBook.Worksheets(1).Range("M" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("AreaSurveyor").Value
DestBook.Worksheets(1).Range("F" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("ProjectTitle").Value
DestBook.Worksheets(1).Range("R" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("B114").Value
'DestBook.Worksheets(1).Range("H" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("ProjectManager").Value
DestBook.Worksheets(1).Range("N" & EndRow).Value = SrcBook.Sheets("BPC Form").Range("ProjectManager").Value
Application.CutCopyMode = False
DestBook.Save
'Transfer Data After Receiving Stage 2 and Email Response Back
ElseIf Me.Range("ArchNo").Value Like "*" And _
Me.Range("K4").Value = "*" And _
Me.Range("K5").Value = "ü" Then
ActiveSheet.Unprotect
'Me.range("Password").Value = Null
TextBox1.Value = ""
'ActiveWorkbook.Save
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Ref = Me.Range("AreaSurveyor")
Ref1 = Me.Range("ProjectManager")
Ref2 = Me.Range("School")
Email = Me.Range("Email")
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = Email
.CC = ""
.BCC = ""
.Subject = Ref2
.Body = Ref1 & vbNewLine & vbNewLine & "Thank for the submission of the Stage 2 BPC Form." & vbNewLine & vbNewLine & "Form will now go forward for approval/consideration at next sub-committe agenda" & vbNewLine & vbNewLine & "Steve Roberts"
'.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'Dim DestBook As Workbook, SrcBook As Workbook
Application.ScreenUpdating = False
Set SrcBook = ThisWorkbook
Set DestBook = Workbooks.Open("C:\Users\stevet\BPC Data Form.xlsx")
Dim rng As Range, c As Range, cfind As Range
On Error Resume Next
With Worksheets("BPC Form")
'Set rng = SrcBook.Sheets("BPC Form").Range("ArchNo").Value
Set rng = Range("ArchNo")
For Each c In rng
'With Worksheets = DestBook.Worksheets(1).Range("A" & EndRow)
With Worksheets(DestBook.Worksheets(1).Name)
Set cfind = .Columns("A:A").Cells.Find _
(what:=c.Value, Lookat:=xlWhole)
If cfind Is Nothing Then GoTo line1
.Cells(cfind.Row, 1) = [ArchNo]
.Cells(cfind.Row, 2) = [DfESNo]
.Cells(cfind.Row, 3) = [LEA]
.Cells(cfind.Row, 4) = [ArchdioceseNo]
.Cells(cfind.Row, 5) = [School]
.Cells(cfind.Row, 13) = [AreaSurveyor]
.Cells(cfind.Row, 6) = [ProjectTitle]
.Cells(cfind.Row, 18) = [B114]
.Cells(cfind.Row, 14) = [ProjectManager]
.Cells(cfind.Row, 15) = [TopContractor]
.Cells(cfind.Row, 16) = [Stage2BuildingCosts]
.Cells(cfind.Row, 17) = [Stage2Total]
'cfind.Copy Worksheets("sheet1").Cells(Rows.Count, "A").End(x1Up).Offest(1, 0)
End With 'sheet1
line1:
Next c
Application.CutCopyMode = False
End With 'BPC Form
End If
'ActiveSheet.Protect Contents:=True
I would like howveer for the above code to do the following also: -
- save the BPC Form as a PDF File.
- Paste/instert, resize and lock it into into cell of Row 'v' of the BPC Data Form as an attachment.
My 'Attach Drawing' buttons at the bottom of the form sort of do this as an example of how I want it to resize and lock it to the cell so assuming some of this code would apply to the above.
Have tried to attach files but not uploading. If you would like to contact me on no. below I could email them to you.
I would also require the changes making before Thursday 24th Feb 2012.
Kind Regards
Steve
Steve T.
0% (0)Projects Completed
1
Freelancers worked with
1
Projects awarded
100%
Last project
21 Feb 2012
United Kingdom
New Proposal
Login to your account and send a proposal now to get this project.
Log inClarification Board Ask a Question
-
There are no clarification messages.
We collect cookies to enable the proper functioning and security of our website, and to enhance your experience. By clicking on 'Accept All Cookies', you consent to the use of these cookies. You can change your 'Cookies Settings' at any time. For more information, please read ourCookie Policy
Cookie Settings
Accept All Cookies