Update monthly sales with New accounts

[msgrant]

Microsoft Excel - Book1 ___Running: xl2000 : OS = Windows 98

(F)ile (E)dit (V)iew (I)nsert (O)ptions (T)ools (D)ata (W)indow (H)elp (A)bout

A1 =


A B C D E F
1 Ac No Area Name Jan-04 Feb-04 Mar-04
2 A014 5 Cobham Fluid Systems Ltd 1528.92 0.00
3 A015 5 Ampohm Capacitors Ltd 0.00 230.60
4 A021 4 Assemtech Europe Ltd 0.00 47.41
5 A027 3 AVX Ltd 0.00 0.00
6 A087 3 ASL Ltd 168.61 102.90
7 A098 3 Antrim Transformers Ltd 0.00 0.00
8 A107 3 Alphasonics 0.00 0.00
9 A117 5 Active Electronics Plc 0.00 1050.00
10 A120 4 Megger Ltd 2455.00 1541.80
11 A125 4 Air Care Products 0.00 1600.00
12 A138 5 Applied Weighing 0.00 435.00
13 A141 5 Antares (Europe) Ltd 320.25 320.25
14 A147 5 Applied Polymer Technology 374.00 0.00
15 A181 5 Alansons Industrial Supplies 498.62 105.06
16 A188 5 Automation Sales Ltd 0.00 0.00
17
18 Ac No Area Name Mar-04
19 A015 5 Ampohm Capacitors Ltd 230.60
20 A021 4 Assemtech Europe Ltd 47.41
21 A040 5 Arcol UK Ltd 109.04
22 A057 5 Arun Electronics Ltd 640.50
23 A141 5 Antares (Europe) Ltd 320.25
24 A181 5 Alansons Industrial Supplies 105.06
25 A204 4 Ami-Con Supplies Ltd 2007.91
26 A207 4 Aerospheres (UK) Ltd 177.09
27 A212 4 Alroy Microwave & Electronics 15.00
28 A233 5 Aquatec Electronics Ltd 1362.50
29 A237 6 Albion Chemicals 2260.40
30 A238 5 Aero Stenraw Ltd 108.45


I have a spreadsheet as above for sales how can i
1 compare col A to see of new account and if so insert line
2 update Mar 04 col with new fig including 0.00 when no sale
been cutting pasting but so long winded

Please help

 

[msgrant]

Yes i am looking to compare ac no current to then to ytd and add current month after last month in ytd ie to go in column H with any new accounts if possible to slot in in ac no order else at bottom so i can then sort hope that makes things clearer

 

[George J]

This seems to work - you just need to add the sorting code or do this manually.

Any problems, just holler

(Almost forgot to paste in the code. )

Sub cur2ytd()
Dim AcNo As Range
Dim lastcol As Integer
Dim lastrow As Integer
Dim i As Range
Dim n As Range
Dim c As Range

Set AcNo = Range(Worksheets("YTD").Range("A2"), Worksheets("YTD").Range("a2").End(xlDown))
lastcol = Worksheets("YTD").UsedRange.End(xlToRight).Offset(0, 1).Column
lastrow = Worksheets("YTD").UsedRange.End(xlDown).Offset(1, 0).Row
irow = 2

With Worksheets("YTD")
While Worksheets("Current").UsedRange.End(xlDown).Row <> irow
    For Each i In AcNo
        If Sheets("Current").Cells(irow, 1) = i Then
            .Cells(i.Row, lastcol) = Sheets("Current").Cells(irow, 4)
        End If
    Next i
    irow = irow + 1
Wend
End With

irow = 3
With Worksheets("Current")
    For Each i In Range(.Range("A3"), .Range("A3").End(xlDown))
    While .UsedRange.End(xlDown).Row + lastrow <> irow

        If .Cells(i.Row, 1) <> Worksheets("YTD").Cells(irow, 1) Then
            irow = irow + 1
            missing = True
        Else
            missing = False
            irow = irow + 1
            GoTo 1
        End If
    Wend
1
        If missing = True Then
            Sheets("YTD").Cells(lastrow, lastcol) = .Cells(i.Row, 4)
            Sheets("YTD").Cells(lastrow, 1) = .Cells(i.Row, 1)
            Sheets("YTD").Cells(lastrow, 2) = .Cells(i.Row, 2)
            Sheets("YTD").Cells(lastrow, 3) = .Cells(i.Row, 3)
        End If
    irow = 3
    missing = False
    lastrow = Worksheets("YTD").UsedRange.End(xlDown).Offset(1, 0).Row
    Next i
    
End With

For Each c In Worksheets("YTD").UsedRange
    If c.Value = "" Then
        c.Value = "0"
    End If
Next c
2
End Sub

 

[msgrant]

Hi George thanks for code but I am getting a runtime error 1004 in line worksheets("YTD").UsedRange.End(xlToRight).Offset(0.1).column line

Application defined or object defined error

Matthew

 

[George J]

Did you copy and paste the code in?

It looks from your example that it is (0.1) instead of (0, 1)

 

[msgrant]

Thanks George got it working great now just those initial lines on html YTD & Current which I had put there for reference only on here that threw it out deleted them and it works great

Kind Regards

Matthew