Need help with two Execl VBA problems

R

ricky

I have an Excel application that does a web query once a day into a
Worksheet called MasterFile that's pasted in rows. Each row represents
unique data that has a corresponding labeled worksheet based on what's
in the first cell(A1 through A?). Currently, I paste up to 20 rows of
data into the MasterFile worksheet and populate 20 worksheets from the
MasterFile sheet checking each worksheet for the next empty row. The
anmount of rows is potentially going to increase in the near future,
that means I'll have to manually add more sheets to match the amount
of rows I query in.

First Excel ??: How can I check if a worksheet already exists and if
not create one automatically?

Second Excel ??: How do I streamline the following code:

Sub PopualteSheets()
Worksheets("MasterFile").Range("A1:H1").Copy _
Destination:=Worksheets("Case"). _
Cells(Rows.Count, "A").End(xlUp)(2)

Worksheets("MasterFile").Range("A2:H2").Copy _
Destination:=Worksheets("Field"). _
Cells(Rows.Count, "A").End(xlUp)(2)

Worksheets("MasterFile").Range("A3:H3).Copy _
Destination:=Worksheets("Product"). _
Cells(Rows.Count, "A").End(xlUp)(2)

Worksheets("MasterFile").Range("A4:H4").Copy _
Destination:=Worksheets("Investment"). _
Cells(Rows.Count, "A").End(xlUp)(2)

'The above code is repeated 20 times once for each row in the
MasterFile.
'It copies a row and pastes it in it's corresponding worksheet into
the next empty row.

End Sub

Can the above subroutine be coded into an array or some type of
looping solution so I don't have to keep adding extra code when a new
row of data appears in the MasterFile worksheet??

Thanks,Rich
 
B

Bob Phillips

Ricky,

1. Here's a simple function to test for file exists

Function FileExists(fn As String) As Boolean
If Dir(fn) <> "" Then FileExists = True
End Function

2. Is this okay?

Sub PopualteSheets()
Dim cLastRow As Long

cLastRow = Worksheets("MasterFile").Cells(Rows.Count, "A").End(xlUp).Row

Worksheets("MasterFile").Range("A1:H" & cLastRow).Copy _
Destination:=Worksheets("Case"). _
Cells(Rows.Count, "A").End(xlUp)(2)

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
A

Anders S

Ricky,

Here is another way. The macro reads col A in the master sheet, adds new sheets as needed and copies the data. As you will notice, the first row in newly added sheets will be empty, you will have to fix that if it bothers you.
The master sheet must be the active sheet when running the macro.

'-----
Option Explicit
' make sure that the master sheet is active when running this
Sub test597()
Dim srcRng As Range, cCell As Range
Dim shName As String

With Range("A1")
Set srcRng = Range(.Cells, .End(xlDown))
End With

For Each cCell In srcRng.Cells

' add sheets
On Error Resume Next
shName = cCell.Value
shName = Worksheets(shName).Name
If Err <> 0 Then
On Error GoTo 0
With ActiveWorkbook.Sheets
.Add after:=.Item(Sheets.Count)
.Item(Sheets.Count).Name = shName
End With
End If

' enter data
With cCell
.CurrentRegion.Rows(.Row).Copy _
Destination:=Worksheets(shName). _
Cells(Rows.Count, "A").End(xlUp)(2)
End With
Next cCell

End Sub
'-----

Best regards
Anders Silven
 
R

ricky

Anders S said:
Ricky,

Here is another way. The macro reads col A in the master sheet, adds new
sheets as needed and copies the data. As you will notice, the first row
in newly added sheets will be empty, you will have to fix that if it
bothers you.
The master sheet must be the active sheet when running the macro.

'-----
Option Explicit
' make sure that the master sheet is active when running this
Sub test597()
Dim srcRng As Range, cCell As Range
Dim shName As String

With Range("A1")
Set srcRng = Range(.Cells, .End(xlDown))
End With

For Each cCell In srcRng.Cells

' add sheets
On Error Resume Next
shName = cCell.Value
shName = Worksheets(shName).Name
If Err <> 0 Then
On Error GoTo 0
With ActiveWorkbook.Sheets
.Add after:=.Item(Sheets.Count)
.Item(Sheets.Count).Name = shName
End With
End If

' enter data
With cCell
.CurrentRegion.Rows(.Row).Copy
Destination:=Worksheets(shName).
Cells(Rows.Count, "A").End(xlUp)(2)
End With
Next cCell

End Sub
'-----

Best regards
Anders Silven
Click to expand...


Thanks Anders Silven this works just I like wanted it to.
Thanks again.
ricky
 
A

Anders S

Thanks Anders Silven this works just I like wanted it to.
Thanks again.
ricky
Click to expand...

Thanks ricky, I'm glad it helped :)

After re-eading the code I made two small changes.
- by better qualifying srcRange the macro now runs from any sheet.
- added On Error GoTo 0 after the Ed If, otherwise On Error Resume Next would be still be active if Err = 0

'----
Option Explicit

Sub test597()
Dim srcRng As Range, cCell As Range
Dim shName As String

With Range("MasterFile!A1")
Set srcRng = Range(.Cells, .End(xlDown))
End With

For Each cCell In srcRng.Cells

' add sheets
On Error Resume Next
shName = cCell.Value
shName = Worksheets(shName).Name
If Err <> 0 Then
On Error GoTo 0
With ActiveWorkbook.Sheets
.Add after:=.Item(Sheets.Count)
.Item(Sheets.Count).Name = shName
End With
End If
On Error GoTo 0

' enter data
With cCell
.CurrentRegion.Rows(.Row).Copy _
Destination:=Worksheets(shName). _
Cells(Rows.Count, "A").End(xlUp)(2)
End With
Next cCell

End Sub
'----

Best regards,
Anders Silven
 
Top