PDA

View Full Version : Create a new worksheet from existing worksheets plus doing calculations.



mufasa
03-19-2008, 05:10 AM
I have motoring spreadsheet. The worksheets is the manufacturers name and each work sheet has data in it.

For Worsksheet Toyota we have the following Headings with Data below it:
Model............Year.............Mileage........Dealer Name.............Price
Corolla...........2006............5500............GK Toyota...............$5000
Corolla...........2003............17000...........Freedom Cars..........$1900
..........................................................................T otal:...$2000000

Auris..............2007...........1900............Freedom Cars...........$10000
Auris..............2008...........500.............LC Auto...................$14000
..........................................................................T otal:...$3000000

For Worsksheet Volkswagen
Model............Year........Dealer Name............Price
Golf..............2005........Tiger VW................$4000
Golf..............1998........Freedom Cars..........$900
..................................................Total:...$1110000

Jetta..............2004.......F1 Auto.................$10000
Jetta..............2008.......Eagle Motors..........$14000
..................................................Total:...$3000000

You will notice there is a difference in the Columns for Toyota and Volkswagen.

Ideally what my client want is a spreadsheet:
Dealer Name.......Model............Total Price
Freedom Cars.....Corolla...........$25640
Freedom Cars.....Golf...............$32610
Eagle Motors......Corolla...........$15871

I'm coming from a C# .net background and what looks easy for you might be a hill to climb for me.

I am going to put my ideas to you and pls assist me with guiding me in the right directions with VBA code.

1) What I would Ideally do is to start with a pointer in A1 then navigate down until I find the string "Model" ... when we reach A50 we know "Model" is not in this column. I them move to B1 and navigate down. This process will be repeated until I find the string "Model". I can then search row by row for the Dealer Name and Price. I then search for Total (Similar to Model) and then I will have my range for a specific model which I then copy to a temp Worksheet. Would you say this is a good Idea? If not what would you recommend.

2)Say for example my idea is brilliant I have copied all the info to the Temp Worksheet. Now I Have 3 columns but not grouped with Total Price ... how do I do this using VBA Code.

Thx for your time ...

Bob Phillips
03-19-2008, 05:37 AM
Won't Model always be on row 1? WOn't it always be in column A?

mufasa
03-19-2008, 05:43 AM
Won't Model always be on row 1? WOn't it always be in column A?
Unfortunately not, Volvo for Example has "Date" in Column A and "Model" is in Column B

Charlize
03-19-2008, 06:09 AM
Unfortunately not, Volvo for Example has "Date" in Column A and "Model" is in Column BProvide a sample with all possible layouts for each manufacturer (And I hope that every manufacturer uses the same layout every time they give you the data.). You'll have to achieve the same layout for every manufacturer before you can even think about creating a report.

Charlize

ps.: or you could hope that someone has something in his sleeve to provide you with an unbelievable solution. Why don't I simply ask the questions I have instead of wasting an hour or so to find a solution ?

Bob Phillips
03-19-2008, 06:09 AM
Option Explicit

Private Const SUMMARY_SHEET As String = "Car Summary"

Sub CollapseData()
Dim mpSheet As Worksheet
Dim mpNextRow As Long

With ActiveWorkbook

On Error Resume Next
Set mpSheet = .Worksheets(SUMMARY_SHEET)
On Error GoTo 0
If mpSheet Is Nothing Then

Set mpSheet = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
mpSheet.Name = SUMMARY_SHEET
End If
mpSheet.Cells.ClearContents

mpNextRow = 1
For Each mpSheet In .Worksheets

If mpSheet.Name <> SUMMARY_SHEET Then

Call GrabData(mpSheet, mpNextRow)
End If
Next mpSheet
With .Worksheets(SUMMARY_SHEET)
.Columns("A:C").Sort key1:=.Range("A1"), order1:=xlAscending, _
key2:=.Range("A2"), order2:=xlAscending, _
header:=xlNo
End With
End With
End Sub

Private Function GrabData(ByRef sh As Worksheet, ByRef NextRow As Long)
Dim mpCell As Range
Dim mpModelCol As Long
Dim mpDealerCol As Long
Dim mpPriceCol As Long
Dim mpLastRow As Long
Dim i As Long

With sh

Set mpCell = .Cells.Find("Model")
If mpCell Is Nothing Then Exit Function
mpModelCol = mpCell.Column

Set mpCell = .Cells.Find("Dealer Name")
If mpCell Is Nothing Then Exit Function
mpDealerCol = mpCell.Column

Set mpCell = .Cells.Find("Price")
If mpCell Is Nothing Then Exit Function
mpPriceCol = mpCell.Column

mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(1, mpDealerCol).Resize(mpLastRow).Copy Worksheets(SUMMARY_SHEET).Cells(NextRow, 1)
.Cells(1, mpModelCol).Resize(mpLastRow).Copy Worksheets(SUMMARY_SHEET).Cells(NextRow, 2)
.Cells(1, mpPriceCol).Resize(mpLastRow).Copy Worksheets(SUMMARY_SHEET).Cells(NextRow, 3)
End With

With Worksheets(SUMMARY_SHEET)

mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = mpLastRow To NextRow Step -1

If Application.CountIf(.Rows(i), "Total:") > 0 Or _
Application.CountIf(.Rows(i), "Dealer Name") > 0 Or _
Application.CountA(.Rows(i)) = 0 Then

.Rows(i).Delete
End If
Next i
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
NextRow = mpLastRow + 1
End With
End Function

mufasa
03-28-2008, 05:10 AM
Hi There

How can I modify this code so that if Column 1 (A) is 0 or null then the row must be deleted. Also if Column 3 (C) is not Numeric it should be moved to new worksheet called Log and the row must be deleted from existing worksheet.

If Application.CountIf(.Rows(i), "Total:") > 0 Or _
Application.CountIf(.Rows(i), "Dealer Name") > 0 Or _
Application.CountA(.Rows(i)) = 0 Then

.Rows(i).Delete
End If

Thanks