View Full Version : Write data to sheet 2 if sheet 1 is full

02-04-2011, 08:50 AM
Hi. I have a workbook with a form layout identical on each sheet (10 sheets). The layout is designed to be printed out, so each sheet/page only holds 25 records, starting at row 32 (B32) down to row 56.

My data goes into the form, but if sheet 1 is full, it needs to go to sheet 2 (again, starting at B32), and write to the next empty row. Similarly, if sheet2 turns out to also be full, then it goes to sheet3, finds the next empty row, writes the data, and so on until it finds a sheet that's not full.

Here's my test code, which for the moment is only concerned with moving to sheet2 if sheet1 is full.

The problem is that if it decides to write to sheet2, the data writes in the wrong place. It will randomly start writing in column N, or S, or something like that; also it's not in the correct row, just a random place. Why is this?


'find next empty row

If ActiveCell.Row > 56 Then

PasteDataWeeklyDeliveryReport 'this just puts the data in the cells
ElseIf ActiveCell.Row < 57 Then

'write the data to the workbook
myWorkbook.Save 'save
myWorkbook.Close 'close
End If

02-09-2011, 03:15 PM

the above code looks OK, but I'm testing it right now, nonetheless. How about providing the code for "PasteDataWeeklyDeliveryReport"?

In the meantime I found something in the Excel help:
"When applied to a Range object, the property is relative to the Range object. For example, if the selection is cell C3, then Selection.Range("B1") returns cell D3 because it’s relative to the Range object returned by the Selection property. On the other hand, the code ActiveSheet.Range("B1") always returns cell B1."
This may explain the funny behavior of your code.
Still testing the code you provided (needs some work to make it run).
Finally, here is the code I'd use:

Option Explicit
Const ENTRY = "This is row "
Const MYSHEET = "Sheet"
Const DATARANGE = "DataRange"
Const MAX_SHEETS = 10
Const STARTCELL = 32
Const LASTROW = 56
Const MAX_ROWS = 25

Dim boolHasWorksheet As Boolean
Dim lngSheetCt As Long
Dim lngRowCt As Long
Dim strStartCell As String
Dim strLastCell As String
Dim strSheetName As String
Dim rngData As Range
Dim myWorkbook As Workbook
Sub FormFiller()

strStartCell = "B" + CStr(STARTCELL)
strLastCell = "B" + CStr(LASTROW)
Set myWorkbook = ThisWorkbook

For lngSheetCt = 1 To MAX_SHEETS
strSheetName = MYSHEET + CStr(lngSheetCt)
boolHasWorksheet = WorksheetExists(strSheetName)
If boolHasWorksheet = False Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = strSheetName
GoSub PasteDataToRange
GoSub PasteDataToRange
End If
Next lngSheetCt

Exit Sub
Set rngData = myWorkbook.Worksheets(strSheetName).Range(strStartCell, strLastCell)
rngData.Name = DATARANGE + CStr(lngSheetCt)
For lngRowCt = 1 To MAX_ROWS
rngData.Cells(lngRowCt, 1).Value = ENTRY + CStr(lngRowCt)
Next lngRowCt
End Sub

Function WorksheetExists(strWorksheetName As String) As Boolean
' only needed locally
Dim boolWorksheetExists As Boolean

For lngSheetCt = 1 To Worksheets.Count
If Worksheets(lngSheetCt).Name <> strWorksheetName And lngSheetCt = Worksheets.Count Then
boolWorksheetExists = False
End If
If Worksheets(lngSheetCt).Name = strWorksheetName Then
boolWorksheetExists = True
Exit For
End If
WorksheetExists = boolWorksheetExists
End Function