Creatings a VBA Module

[Carlthomas]

Hi all,

Just a quick question

I have a spreadsheet that has a count for each employment type for
every zonecode in manchester (i.e. for each zonecode a breakdown of the
diferent employment types is given).

I want to create a VBA module to list (in a new sheet - sheet 3) the
largest employment type in each zonecode based on the data in sheet 2.

I hope that made sense

Please have a look at the attached file for clarification. I can go
through the data in sheet 2 and manually type the data into sheet 3 but
this is very tedious (long and boring) . Is there anyone who can help
automate this process?

I would really appreciate your help with this..

Thanks in advance

Carl.


+-------------------------------------------------------------------+
|Filename: ManA2.zip |
|Download: http://www.excelforum.com/attachment.php?postid=4667 |
+-------------------------------------------------------------------+

 

[Bob Phillips]

I used this code, but every one came out as cs0440001 for me

Sub HighestTypes()
Dim iLastrow As Long
Dim i As Long
Dim iRow As Long
Dim iMax As Long
Worksheets("Sheet3").Activate
With Worksheets("Sheet2")
iLastrow = .Cells(.Rows.Count, "A").End(xlUp).row
For i = 2 To Cells(Rows.Count, "A").End(xlUp).row
iMax = .Evaluate("MAX(IF(Sheet2!A2:A" & iLastrow & "=Sheet3!A" &
i & ",Sheet2!C2:C" & iLastrow & "))")
iRow = .Evaluate("MATCH(1,(Sheet2!A2:A" & iLastrow & "=Sheet3!A"
& i & ")*(Sheet2!C2:C" & iLastrow & "=" & iMax & "),0)")
Cells(i, "B").Value = .Cells(iRow + 1, "B").Value
Next i
End With
End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

 

[Rick Hansen]

Carl, Here try this code. I also got results as Bob did with my code of,
cs0440001..
Good Luck Rick

Sub HighTypes()
Dim LastRow As Long, lRow As Long
Dim ws2 As Worksheet, ws3 As Worksheet
Dim Top As Long, ws3row As Long
Dim ZoneStr As String
Dim ans As Integer
Dim rngHigh As Range

Set ws3 = Worksheets("sheet3")
With ws3
.Activate
.Range("A2:C" & .Range("C2").End(xlDown).Row).ClearContents
ws3row = 2
End With

Set ws2 = Worksheets("sheet2")
With ws2
LastRow = .Range("A2").End(xlDown).Row
lRow = 2
Do
Top = lRow
ZoneStr = .Cells(Top, "A").Value
Do
lRow = lRow + 1
Loop While (ZoneStr = .Cells(lRow, "A"))

ans = Application.WorksheetFunction.Max(.Range("c" & Top & ":C" &
lRow - 1))
Set rngHigh = .Range("c" & Top & ":C" & lRow - 1).Find(what:=ans)
If Not rngHigh Is Nothing Then
.Range("A" & rngHigh.Row & ":C" & rngHigh.Row).Copy ws3.Range("A" &
ws3row)
ws3row = ws3row + 1
End If
Loop While (lRow <> LastRow + 1)
End With

End Sub

 

[Carlthomas]

woah!! Thanks Rick & Bob for the quick replies!!

I tried the code you both suggested and i get a Complie error: syntax
error, with the yellow arrow pointing to
Code:
--------------------
Sub HighestTypes
--------------------

Because i got the same error for both codes i'm guessing some setting
is not right on my side? Any advice for a total novice?

Thanks again,

Carl.

 

[Bob Phillips]

Carl,

Firstly, did you add the code into a standard code module in the VBIDE
(Alt-F11, Insert>Module)?

Is there some code before that statement? If so, can you post ALL of that
for us to see?

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

 

[Carlthomas]

Hi Bob,

I figured it out...I was being stupid, all i did was copy and paste the
code in to the editor but didn't reaslise the code that should have been
on one line was split over two (D'oh).

I've corrected it and it works!! Woo hoo!

Thanks for all your help Bob & Rick!!!


kind regards,
Carl