Copy rows untill 0

[loudey]

Hi

I'm trying to write a VB code that can copy the value of the cells between B56 through BB56 to a different excel file (called database). the first file's name can be different names but it will be the file where the macro will be imbeded and run from. also the macro will need to loop in the next colum (for example B57 through BB57) and keep looping untill the value in B(and that column) is equal to zero

any help on where i could start would be appreciated

thanks

[SammyB]

Well, I have a lot of questions, but basically what you want is

Option Explicit
Sub Copy2DB()
'   Copy columns B thru BB, starting at row 56
    Dim i As Integer
    i = 56
    Do While Range("B" & i) <> 0
        Range("B" & i & ":BB" & i).Copy Workbooks("Database.xlsx").ActiveSheet.Range("B" & i & ":BB" & i)
        i = i + 1
    Loop
End Sub

Since I didn't have answers to my questions, I made the following assumptions:
1) The Database workbook is already open with the same instance of Excel
2) You are using Excel 2003 or later, if not change the Database.xlsx to Database.xls
3) You want to copy the data to the same range in the Database
4) The data that you want to copy is on the current active sheet
5) I did not understand when to stop the copy: I did it until cell Bn was empty or zero (where n is the row number)

Let us know if this is not what you want. --Sam

[loudey]

Thanks SammyB for the quick response it is actually a little more complicated than what i mentioned i just thought i might be able to figure it out once i get that piece. anyway here is a piece of the code that is able to do what i want however i also want it to check if this item already exist in the database and if it does delete the one on there and copy the new one.

so the following code without the if statment works just fine but once i try to tell it to test for the item number it gives me an error that says "Pastespeci al Method of Range class faild"

'Copy Item Information from "Export Data" to "Recap Item Detailed"
    Sheets("Export Data").Select
    Range("B4:AM200").Copy
    Application.Workbooks.Open ("C:\Documents and Settings\USKHYAS\Desktop\Monthly Quotation\monthly quotation report.xls")
    Sheets("Recap Item Detailed").Select
    NumRows = Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count
    
   [B][I] 'Check if older version of this item exists and delete it
    For i = NumRows To 1 Step -1

    If Cells(i, 1).Value = QuoteNo Then
        Rows(i).Delete
    End If

    Next i
    NumRows = Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count[/I] '[/B]
    
    Cells(NumRows + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False

thanks again and i appreciate all the help

[SammyB]

Don't have time to check it until Friday, but off the top of my head replace 18 with two lines:
Cells(NumRows + 1, 1).Select
ActiveSheet.Pas teSpecial Paste:=xlPasteV alues, Operation:=xlNo ne, SkipBlanks:=Tru e, Transpose:=Fals e

Hope this works for you! BTW, when I write code involving 2 workbooks, I create an object for each book and/or sheet and fully define each range reference. Your mind keeps track, but XL doesn't read your mind.

From your original post, I thought you were copying a variable sized range of cells. Is this not correct?

[loudey]

Hi SammyB

Friday would be no problem.

when i replaced line 18 with the two line you provided i got this error now.
"Run time error '1004':
Application-defined or object-defined error"

and yes i started wanting to copy a variable sized range but then found another workbook that contain the information that i wanted but it won't go past row 200 so i decided to copy the whole thing and skip any blanks.


if this would help here is my whole code. I'm a very new at this so some of it might not be very well done but it works so far (except for that piece ofcourse)

here is the premise of what I'm trying to do.
- everything that i'm copying is from a bunch of excel workbooks (project workbook) to one central excel workbook that acts as a database
- this code will be in the project sheets and once it is run it will open the databse and start copying
- it will copy overall project information from a number of scattered fields from the project workbook into one line in the database in an overall summary sheet
- it will also need to copy items within that project into another sheet in the databse (those items are repeated and the number of times they are repated in every project is different so times you would have 3 lines and you could have 13 but for the most part not more than 30 lines)
* the name of the project workbooks will be different everytime

Public Sub QuoteTransfer()

'Variable Definition for the "Recap Detailed" Sheet
Dim QuoteNo As Variant
Dim QuoteRev As Variant
Dim MarkRep As Variant
Dim QuoteDate As Date
Dim ProjectName As Variant
Dim SalesChannel As Variant
Dim CustomerName As Variant
Dim EndUser As Variant
Dim EndUserSeg As Variant
Dim SoldICM As Variant
Dim SalesComm As Variant
Dim LiqDam As Variant
Dim QuoteType As Variant
Dim TandC As Variant
Dim PerfBond As Variant
Dim EstOrderDate As Date
Dim InspTest As Variant
Dim CertLabel As Variant
Dim QuotePrice As Currency
Dim OrderMargin As Variant
Dim GrossValue As Currency
Dim GrossMargin As Variant
Dim NetValue As Currency
Dim NetMargin As Variant
Dim DirectMaterial As Variant
Dim BrkrType As Variant

Dim NumRows As Integer
Dim NumCols As Integer

'Select the "Recap" Sheet
Sheets("Recap").Select

'Input time stamp under the button
Range("G52").Formula = "=Now()"

'Align Project Variables with their cells in the "Recap" sheet
QuoteNo = Range("E5").Value
QuoteRev = Range("E6").Value
MarkRep = Range("E15").Value
QuoteDate = Range("E40").Value
ProjectName = Range("E11").Value
SalesChannel = Range("E9").Value
CustomerName = Range("E12").Value
EndUser = Range("E13").Value
EndUserSeg = Range("E21").Value
SoldICM = Range("E28").Value
SalesComm = Range("E29").Value
QuoteType = Range("E20").Value
TandC = Range("E22").Value
LiqDam = Range("E31").Value
PerfBond = Range("E35").Value
EstOrderDate = Range("E43").Value
InspTest = Range("E47").Value
CertLabel = Range("E48").Value
QuotePrice = Range("J7").Value
OrderMargin = Range("J9").Value
GrossValue = Range("J30").Value
GrossMargin = Range("J31").Value
NetValue = Range("J43").Value
NetMargin = Range("J44").Value
DirectMaterial = Range("J46").Value
BrkrType = Range("N31").Value

'Copy Item Information from "Export Data" to "Recap Item Detailed"
    Sheets("Export Data").Select
    Range("B4:AM200").Copy
    Application.Workbooks.Open ("C:\Documents and Settings\USKHYAS\Desktop\Monthly Quotation\monthly quotation report.xls")
    Sheets("Recap Item Detailed").Select
    NumRows = Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count
    
    'Delete if older version of this item exists and delete it
    For i = NumRows To 1 Step -1

    If Cells(i, 38).Value = QuoteNo Then
        Rows(i).Delete
    End If

    Next i
    NumRows = Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count
    
    Cells(NumRows + 1, 1).Select
    ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False

'Select the "Recap Detailed" Sheet
Sheets("RECAP Detailed").Select
NumRows = Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count
NumCols = Range(Range("A2").End(xlToRight), Range("A2")).Columns.Count

'Chech if older version of this quote exists in the database and delete it
For i = NumRows To 1 Step -1

    If Cells(i, 1).Value = QuoteNo Then
        Rows(i).Delete
    End If

Next i
NumRows = Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count

'Copy cells from the "Recap" sheet to the "Recap Detalied" sheet in the database
Cells(NumRows + 1, 1).Value = QuoteNo
Cells(NumRows + 1, 2).Value = QuoteRev
Cells(NumRows + 1, 3).Value = MarkRep
Cells(NumRows + 1, 4).Value = QuoteDate
Cells(NumRows + 1, 5).Value = ProjectName
Cells(NumRows + 1, 6).Value = SalesChannel
Cells(NumRows + 1, 7).Value = CustomerName
Cells(NumRows + 1, 8).Value = EndUser
Cells(NumRows + 1, 9).Value = EndUserSeg
Cells(NumRows + 1, 10).Value = SoldICM
Cells(NumRows + 1, 11).Value = SalesComm
Cells(NumRows + 1, 12).Value = QuoteType
Cells(NumRows + 1, 13).Value = TandC
Cells(NumRows + 1, 14).Value = LiqDam
Cells(NumRows + 1, 15).Value = PerfBond
Cells(NumRows + 1, 16).Value = EstOrderDate
Cells(NumRows + 1, 17).Value = InspTest
Cells(NumRows + 1, 18).Value = CertLabel
Cells(NumRows + 1, 19).Value = QuotePrice
Cells(NumRows + 1, 20).Value = OrderMargin
Cells(NumRows + 1, 21).Value = GrossValue
Cells(NumRows + 1, 22).Value = GrossMargin
Cells(NumRows + 1, 23).Value = NetValue
Cells(NumRows + 1, 24).Value = NetMargin
Cells(NumRows + 1, 25).Value = DirectMaterial
Cells(NumRows + 1, 26).Value = BrkrType


'Save the database and close it
Application.Workbooks("monthly quotation report.xls").Save

Application.Workbooks("monthly quotation report.xls").Close


End Sub

again thanks for all the help and sorry i was just giving you bits and pieces but didn't want to bother you with the whole thing. anyway thanks

[loudey]

BTW i just want to let you know that i see the problem now.

the issue is that I am copying and then deleting (inside the "if" clause) and then pasting. But if the "if" clause have run then the program can't paste because when excel deletes a cell it also tends to forget whatever that it has in the clipboard also

I still don't know how to fix it though

[SammyB]

Sorry, had a flat tire on Thursday eve, so I skipped work on Friday. I use OpenOffice at home so I'm still no good.

But, your problem is easy: after the Copy comment, line 68, insert
Dim ws as Worksheet
Set ws = Sheets("Export Data")

Then delete the copy, lines 69 and 70, because we will do it later

Finally, before the PasteSpecial, line 85, do the copy:
ws.Range("B4:AM 200").Copy (you could also do the ws.Select, but it's not necessary)

Hopefully, this will make Excel happy!

Then before

[loudey]

Thanks SammyB

I did what you told me and it works like a charm

I appreciate it