Copying to Next Empty Row

**Pasha81** · 11-10-2009, 12:53 PM

Hi guys

Worksheet 'Raw' has a few rows of Data that get send to 3 different sheets based on the Account# in Column A. The Date Column always shows 1 date, as the values are for different products on the same day.

The Code starts of by checking if any value in Column AG has a '#N/A' value, If it does then the macro will give a message and exit. However I'm getting a row of 'N/A' values in Sheets 101,201 and 301. If there is an N/A value in Column AG i dont want the macro to do anything.

2nd issue - I need to adjust the macro so that it copies these values into the Next Empty Row in sheets 101,201 and 301, not to overwrite the previous row there.

I think somthing like the following code may be required but I couldnt make it work

Dim NextRw as Long
NextRw = .Cells(.Rows.Count, 1).End(xlUp).Row+1

Here's the code I currently have


Sub Allocation()
 
Dim ws As Worksheet, rData As Range, n As Long

 
Application.ScreenUpdating = False

Dim cell        As Range
    
    For Each cell In Intersect(ActiveSheet.UsedRange, Columns("AG"))
        If cell.Text = "#N/A" Then
            cell.Select
            MsgBox "New contract detected. Please identify asset class and update IMAP sheet before continuing."
            Exit For
        End If
    Next cell
    
With Sheets("Raw")
    Set rData = .Range("A2", .Range("AG" & Rows.Count).End(xlUp))
End With



For Each ws In Worksheets



    If ws.Name Like "###" Then
        ws.Cells(3, 1).Value = Sheets("Raw").Cells(2, 3)
        ws.Cells(3, 2).Resize(, 10).Formula = _
            "=SUMPRODUCT((Raw!" & rData.Columns(1).Address & "=" & ws.Name & ")*(Raw!" & rData.Columns(33).Address & "=B2)*(Raw!" & rData.Columns(8).Address & "))"
    End If
Next ws

Application.ScreenUpdating = True
   
End Sub

any suggestions?

Thanks

**StephenR** · 11-10-2009, 01:18 PM

I thought that looked familiar. I answered a previous question and provided some code to avoid overwriting which I guess you didn't see. Atm you have entries around row 60 of your sheets which is throwing out anything and caused me to scratch my head for several minutes. Try this:

Sub Allocation()
 
Dim ws As Worksheet, rData As Range, n As Long, rCell As Range

Application.ScreenUpdating = False

With Sheets("Raw")
    Set rData = .Range("A2", .Range("AG" & Rows.Count).End(xlUp))
End With

For Each rCell In rData.Columns(33).Cells
    If WorksheetFunction.IsNA(rCell) Then
        rCell.Select
        MsgBox "New contract detected. Please identify asset class and update IMAP sheet before continuing."
        GoTo line1
    End If
Next rCell

For Each ws In Worksheets
    With ws
        If .Name Like "###" Then
            With .Cells(Rows.Count, 1).End(xlUp)(2)
                .Value = Sheets("Raw").Cells(2, 3).Value
                .Offset(, 1).Resize(, 10).Formula = _
                    "=SUMPRODUCT((Raw!" & rData.Columns(1).Address & "=" & ws.Name & ")*(Raw!" & rData.Columns(33).Address & "=B2)*(Raw!" & rData.Columns(8).Address & "))"
                .Offset(, 1).Resize(, 10).Value = .Offset(, 1).Resize(, 10).Value
            End With
        End If
    End With
Next ws

line1:
Application.ScreenUpdating = True
   
End Sub

**Pasha81** · 11-10-2009, 01:27 PM

Brilliant Stephen! That works great
I just noticed those values on Row 60, I guess when I was testing different codes it got posted there without me realizing it.

Many Thanks!