Wrox Programmer Forums

Need to download code?

View our list of code downloads.

Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
Password Reminder
Register
| FAQ | Members List | Search | Today's Posts | Mark Forums Read
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of tens of thousands of software programmers and website developers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining today you can post your own programming questions, respond to other developers’ questions, and eliminate the ads that are displayed to guests. Registration is fast, simple and absolutely free .
DRM-free e-books 300x50
Reply
 
Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old December 29th, 2005, 09:08 AM
Registered User
 
Join Date: Dec 2005
Location: , , .
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default Speed up code - looping and copy / paste

Hi,

I have some code that I'm trying to optimise.
It's below. Note that "Target";"Actual" and "Number" are all ranges with inputs; "Difference" is Target minus Actual

Sub Iteration()

 Check1 = True 'does anyone know if this does anything??

 Do
   Range("Target").Select
        Selection.Copy

   Range("Actual").Activate
        ActiveCell.Offset(0, Range("Number") + 1).PasteSpecial
   Paste:=xlValues

       Counter2 = Round(Range("Difference"), 3)

            If Counter2 = 0 Then
                  Exit Do
            End If
  Loop

End Sub

Can anyone suggest how make it cleaner - I'm trying to take out the 'copy and paste' and just have a Destination line with no luck
Thanks for your assistance in advance!

Reply With Quote
  #2 (permalink)  
Old March 20th, 2011, 11:18 AM
Registered User
 
Join Date: Mar 2011
Posts: 4
Thanks: 0
Thanked 0 Times in 0 Posts
Default VBA copy to other worksheet

I am new to VBA therefore needs help.

I have three worksheet say CompanyA, Supplier1 & Supplier2.

In CompanyA it has headers:
Date Company Payment Amount Invoice No. Comments

I update these details when I make payments to Supplier1 & 2, then I have to go and update the two Suppliers' worksheet.

Can anyone help me in VBA so that I just use a VBA comment or button to update these data automatically without having to copy and pasting myself.

Please feel free if anyone knows an easier than what I'm thinking.
Reply With Quote
  #3 (permalink)  
Old March 21st, 2011, 10:34 PM
Friend of Wrox
Points: 689, Level: 9
Points: 689, Level: 9 Points: 689, Level: 9 Points: 689, Level: 9
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default Create a form

Best way I think is to create a form with the text boxes for each of your headers on the CompanyA worksheet, except the supplier header.

For the supplier header, put a combobox on the form and name it SupplierComboBox.

Put three buttons on it too, name one UpdateAndNewButton, name one OKButton and the other CancelButton. Then in the module behind the form, paste the following code:
Code:
Option Explicit

Dim shtCompanyA As Worksheet
Dim shtSupplier1 As Worksheet
Dim shtSupplier2 As Worksheet
Dim shtCurrentSupplier As Worksheet

Private Sub OKButton_Click()

UpdateSheets
Me.Hide

End Sub

Private Sub CancelButton_Click()
Me.Hide
End Sub


Private Sub UpdateAndNewButton_Click()
UpdateSheets

'reset the form for the next entry
SupplierComboBox.Text = ""
DateTextBox.Text = Format(Now(), "mm/dd")
End Sub

Private Sub UserForm_Activate()
DateTextBox.Text = Format(Now(), "mm/dd")
End Sub

Private Sub UserForm_Initialize()
SupplierComboBox.AddItem ("Supplier1")
SupplierComboBox.AddItem ("Supplier2")
Set shtCompanyA = Sheets("CompanyA")
Set shtSupplier1 = Sheets("Supplier1")
Set shtSupplier2 = Sheets("Supplier2")
End Sub

Sub UpdateSheets()
Dim lNextCompanyARow As Long
Dim lNextSupplierRow As Long

'Get the next available company row to enter data
lNextCompanyARow = WorksheetFunction.CountA(shtCompanyA.Range("A:A")) + 1

'set the supplier worksheet we'll be entering data onto
If SupplierComboBox.Text = "Supplier1" Then
    Set shtCurrentSupplier = shtSupplier1
ElseIf SupplierComboBox.Text = "Supplier2" Then
    Set shtCurrentSupplier = shtSupplier2
'-----------------------------------------------------------------
'For every available supplier, just add another "ElseIf" block
'-----------------------------------------------------------------
End If

'Get the next available supplier row to enter data
lNextSupplierRow = WorksheetFunction.CountA(shtCurrentSupplier.Range("A:A")) + 1

'enter the values in CompanyA
With shtCompanyA
    .Cells(lNextCompanyARow, 1) = DateTextBox.Text
    .Cells(lNextCompanyARow, 2) = SupplierComboBox.Text
    '----------------------------------------------------------------------------------
    'for each additional field, just add another ".Cells(lNextCompanyARow, 1) = " line
    '------------------------------------------------------------------------------------
End With

'update the current supplier sheet
With shtCurrentSupplier
    .Cells(lNextSupplierRow, 1) = DateTextBox.Text
    '----------------------------------------------------------------------------------
    'for each additional field, just add another ".Cells(lNextSupplierRow, 1) = " line
    '------------------------------------------------------------------------------------
End With

End Sub
You'll notice i didn't add a the code for each of your headers to fill in the appropriate column, but you should be able to figure that out. Hope this helps.

Last edited by mtranchi; March 21st, 2011 at 10:40 PM..
Reply With Quote
  #4 (permalink)  
Old March 22nd, 2011, 10:34 AM
Registered User
 
Join Date: Mar 2011
Posts: 4
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Dear mtranchi

This method is too complicated for me, is there an easier way.

Sonny
Reply With Quote
  #5 (permalink)  
Old March 22nd, 2011, 04:22 PM
Friend of Wrox
Points: 689, Level: 9
Points: 689, Level: 9 Points: 689, Level: 9 Points: 689, Level: 9
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default

Ok, hopefully you know how to put a button on a worksheet and change it's name. Put a button on a sheet you've named "CompanyA" and change its name to "UpdateSupplierButton". Then go into the module behind the "CompanyA" worksheet and paste this code.
Code:
Option Explicit

Private Sub UpdateSupplierButton_Click()
'------------------------------------------------------------------------------------------------------------
'This will take the last row of data on the CompanyA worksheet and enter it into whichever supplier is entered into the "B"
    'column on the CompanyA worksheet.
'Whatever value you enter into the supplier ("B") column, there must be a worksheet with that name in the workbook.
    'I would suggest setting up data validation for the supplier column so that you cannot make typos
'--------------------------------------------------------------------------------------------------------------
Dim shtCompanyA As Worksheet
Dim shtCurrentSupplier As Worksheet
Dim lLastCompanyARow As Long
Dim lNextSupplierRow As Long

'Date Company Payment Amount Invoice No. Comments field variables
Dim dtDate As Date
Dim stCompany As String
Dim dPayment As Double
Dim stInvoiceNum As String
Dim stComments As String

'If you want to rename the "CompanyA" worksheet, rename it in the following line as well
Set shtCompanyA = Sheets("CompanyA")

'Get the last company row data entered
lLastCompanyARow = WorksheetFunction.CountA(shtCompanyA.Range("A:A"))

'set the supplier worksheet we'll be entering data onto
With shtCompanyA
    '------------------------------------------------------------------------------------------------------------------------
    'if you want to change the column that recieves the supplier name, in the following line, ".Cells(lLastCompanyARow, 2)",
        'the 2 represents the "B" column, 3 would represent the "C" column, and so on.
    'Also, if you want to rename the "Supplier1" etc. sheets, here is where you'd rename them in the code so that the code
        'still works
    '------------------------------------------------------------------------------------------------------------------------
    If .Cells(lLastCompanyARow, 2) = "Supplier1" Then
        Set shtCurrentSupplier = Sheets("Supplier1")
    '-----------------------------------------------------------------
    'For every available supplier, just add another "ElseIf" block like the one below
    '-----------------------------------------------------------------
    ElseIf .Cells(lLastCompanyARow, 2) = "Supplier2" Then
        Set shtCurrentSupplier = Sheets("Supplier2")
    Else
        MsgBox "No worksheet exists with that supplier name.", vbCritical
        End
    End If
    
    'Get the values from the last row of CompanyA
    '-----------------------------------------------------------------
    'This assumes that the fields are in the exact order as your original post and you want to put each field onto the supplier
        'worksheet. Edit as necessary.
    '-----------------------------------------------------------------
    dtDate = .Cells(lLastCompanyARow, 1)
    stCompany = .Cells(lLastCompanyARow, 2)
    dPayment = .Cells(lLastCompanyARow, 3)
    stInvoiceNum = .Cells(lLastCompanyARow, 4)
    stComments = .Cells(lLastCompanyARow, 5)
End With

'Get the next available supplier row to enter data
'-------------------------------------------------------------------------------------------------------
'This assumes you have no blank rows above your headers. If you do, the "+1" ending of the next line will need to be adjusted
'-------------------------------------------------------------------------------------------------------
lNextSupplierRow = WorksheetFunction.CountA(shtCurrentSupplier.Range("A:A")) + 1

'update the current supplier sheet
With shtCurrentSupplier
    .Cells(lNextSupplierRow, 1) = dtDate
    .Cells(lNextSupplierRow, 2) = stCompany
    .Cells(lNextSupplierRow, 3) = dPayment
    .Cells(lNextSupplierRow, 4) = stInvoiceNum
    .Cells(lNextSupplierRow, 5) = stComments
End With

'Release computer's memory
Set shtCompanyA = Nothing
Set shtCurrentSupplier = Nothing
End Sub
Hopefully that will at least get you started to exactly what you're looking for. Cheers
Reply With Quote
  #6 (permalink)  
Old March 23rd, 2011, 11:29 AM
Registered User
 
Join Date: Mar 2011
Posts: 4
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Thanks very much, I'll try and get back to you.
Reply With Quote
  #7 (permalink)  
Old March 23rd, 2011, 05:27 PM
Friend of Wrox
Points: 689, Level: 9
Points: 689, Level: 9 Points: 689, Level: 9 Points: 689, Level: 9
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default

No problem, glad to help. Sounds like you don't have much experience with VBA (visual basic for applications), so if you don't know how to get to the VBE (visual basic editor), and you have office 2007 or 2010, do a google search on "show developer tab office 2010" because by default they have it hidden. On that tab you'll see on the far left VBE or show visual basic editor or something like that. Other google searches you might need are "show project explorer in visual basic editor vba" (once you see the project explorer, double click on 'CompanyA' sheet and that gets you to the module where you should paste the code), "add a button to a worksheet office 2010", "rename a button on a worksheet office 2010". Good luck.
Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
copy paste !!!!!!! dpkbahuguna Beginning VB 6 1 March 30th, 2007 10:06 AM
copy paste problem paul20091968 Excel VBA 4 November 20th, 2006 10:48 AM
Copy, Paste dpkbahuguna Beginning VB 6 1 October 26th, 2006 10:30 AM
copy and paste url k.manisha ASP.NET 1.0 and 1.1 Professional 1 October 14th, 2006 05:15 AM
How to speed up looping ADO code? llowwelll Pro VB Databases 7 October 24th, 2004 11:12 PM



All times are GMT -4. The time now is 03:47 PM.


Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
© 2013 John Wiley & Sons, Inc.