PDA

View Full Version : Making a report based on 4 sheets



itipu
03-21-2007, 02:26 AM
Thanks guys/girls:

I have a spreadhseet with a Macro. Inside there are 4 sheets:

AD
AC
RHN
LRAM

First column of every sheet (Machine Name) contains machine names...

Upon click the button, a new sheet (Main Report) will be created...

I would like to copy all machine names from all 4 sheets to the first column of (Main Report) however there will be duplicates, so those will have to be removed...

Next I would like Column2, Column3, Cloumn4 & Coulmn5 in (Main Report) to be the names of 4 sheets I have, so AD, AC, RHN & LRAM... and if a machine in Column1 is found/not found in corresponding sheet (AD, AC, RHN, LRAM) Yes/No should appear in (Main Report)... I created a (Sample Output of Main Report) sheet to visualize what I mean.. Maco attached... would really really appreciate your help!

Thanks

Mike

mvidas
03-21-2007, 07:47 AM
Hi Mike,

This will be easy to do, though I don't see "AD" (I'm guessing this is "Computer").
In order to make an intuitive macro (in case the names of the sheets aren't the same or you have more/less than 4 sheets you want to compile), do you want me to have a macro look at all sheets that have the naming format of "word dd.mm.yyyy at hh.mm", and use 'word' as the columns
in your Main Report?
Assuming all that is correct, give this a try:Sub itipu()
Dim WS As Worksheet, WSNames() As String, MachineNames() As String, Cnt As Long, i As Long
Dim CLL As Range, j As Long, MachName As String
ReDim WSNames(0)
Cnt = 0
For Each WS In ActiveWorkbook.Sheets
If WS.Name Like "*at ##.##" Then
ReDim Preserve WSNames(Cnt)
WSNames(Cnt) = WS.Name
Cnt = Cnt + 1
End If
Next
If Cnt = 0 Then
MsgBox "No sheets found on workbook '" & ActiveWorkbook.Name & "'. Exiting"
Exit Sub
End If
ReDim MachineNames(0)
Cnt = 0
For i = 0 To UBound(WSNames)
Set WS = Sheets(WSNames(i))
If WS.Cells(WS.Rows.Count, 1).End(xlUp).Row > 1 Then
For Each CLL In WS.Range("A2", WS.Cells(WS.Rows.Count, 1).End(xlUp)).Cells
MachName = CLL.Text
For j = 0 To Cnt - 1
If MachineNames(j) = MachName Then Exit For
Next
If j = Cnt Then
ReDim Preserve MachineNames(Cnt)
MachineNames(Cnt) = MachName
Cnt = Cnt + 1
End If
Next
End If
Next
If Cnt = 0 Then
MsgBox "No machine names found? Exiting"
Exit Sub
End If
Application.ScreenUpdating = False
Set WS = Worksheets.Add(After:=Sheets(Sheets.Count))
WS.Name = "Main Report"
WS.Range("A1").Value = "Machine Name"
For i = 0 To UBound(WSNames)
WS.Range("B1").Offset(0, i).Value = Left(WSNames(i), InStr(1, WSNames(i), " ") - 1)
Next
For i = 0 To UBound(MachineNames)
With WS.Cells(WS.Rows.Count, 1).End(xlUp).Offset(1, 0)
.Value = MachineNames(i)
For j = 0 To UBound(WSNames)
.Offset(0, j + 1).Value = IIf(Sheets(WSNames(j)).Columns("A").Find( _
MachineNames(i), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing, "no", "yes")
Next
End With
Next
Application.ScreenUpdating = True
End SubLet me know if you need anything else!
Matt

itipu
03-21-2007, 08:17 AM
Hi Matt, thanks a lot for helping m8!

I have advanced a little bit.. so if you have a look at my latest test.xls you'll see that if you start generating report it does a very good output (exactly as I require it... ) all I need is just to get yes/no'in place... and this is where I have no clue how...

So if you could possible tweak my existing script, to make it generate yes & no's I'd be much much obliged...

With regards to names, test.xls is just a small part of the whole Macro, so sheets names are always the same except for time and date... but my test.xls chooses only by Computer/LRAM/RHN/AC not the time and date, so the way it is currently is fine...

AD is computer ;) correct...

You might find that my macro is not the most optimal one but hey it works :)

Thanks a million m8!

Mike

mvidas
03-21-2007, 08:40 AM
I could add a bit to your code to show you how I'd do it (using your code as a basis), but why not just add my function above (change the sub name if desired), then change your Report sub to something like:Public Sub Report()
Call itipu 'change this if you change the name of my sub
Unload UserForm5
Unload frmExtract
End Sub

As I said I could add to yours, but I'd likely just use some/most of the code I have above anyways. If you didn't want to have a separate sub like that, just copy the inner-code into your Report sub, replacing everything but those Unload lines.

itipu
03-21-2007, 08:43 AM
Well main reason is, I still want to use my UserForm that allows to choose which sheets to use for reports... for once, usually I can have many sheets, and just dates & times a re different, for twice I use it for other purposes.... so really do need to use through the set-up I did... choose for sheets click select... and than run your function... but it will have to be stripped of some stuff.. and if I look at it, I am not too sure what to remove...

Thanks again,.

Mike

mvidas
03-21-2007, 09:11 AM
I understand now, I guess I didn't look close enough at it, I didn't think of there being one sheet called "RHN 21.03.2007 at 08.34" and you could have another called "RHN 21.03.2007 at 10.34", and you wouldn't want both. We'll get this working right for you :)

From what I can tell, it looks like on the 'computer' sheet (AD), you want all computers listed there that don't have "-s-" in it, is that correct? And none of the other sheets have any restrictions like that?

Matt

mvidas
03-21-2007, 10:03 AM
Assuming that is correct (I won't wait any longer for your response, as you're likely out of work and won't check again until tomorrow), use the following for your Report function (you can remove the Del function too if you want, it isnt needed anymore):Public Sub Report()
Dim WS As Worksheet, WSNames(), MachineNames() As String, Cnt As Long, i As Long
Dim CLL As Range, j As Long, MachName As String
ReDim MachineNames(0)
Cnt = 0
Set WS = Sheets(llist)
If WS.Cells(WS.Rows.Count, 1).End(xlUp).Row > 1 Then
For Each CLL In WS.Range("A2", WS.Cells(WS.Rows.Count, 1).End(xlUp)).Cells
MachName = CLL.Text
If Not LCase(MachName) Like "*-s-*" Then
For j = 0 To Cnt - 1
If MachineNames(j) = MachName Then Exit For
Next
If j = Cnt Then
ReDim Preserve MachineNames(Cnt)
MachineNames(Cnt) = MachName
Cnt = Cnt + 1
End If
End If
Next
End If
WSNames = Array(llist, llist1, llist2, llist3)
For i = LBound(WSNames) + 1 To UBound(WSNames)
Set WS = Sheets(WSNames(i))
If WS.Cells(WS.Rows.Count, 1).End(xlUp).Row > 1 Then
For Each CLL In WS.Range("A2", WS.Cells(WS.Rows.Count, 1).End(xlUp)).Cells
MachName = CLL.Text
For j = 0 To Cnt - 1
If MachineNames(j) = MachName Then Exit For
Next
If j = Cnt Then
ReDim Preserve MachineNames(Cnt)
MachineNames(Cnt) = MachName
Cnt = Cnt + 1
End If
Next
End If
Next
If Cnt = 0 Then
MsgBox "No machine names found? Exiting"
Exit Sub
End If
Application.ScreenUpdating = False
Set WS = Worksheets.Add(After:=Sheets(Sheets.Count))
WS.Name = "Main Report"
WS.Range("A1:E1").Value = Array("Machine Name", "AD", "AC", "RHN", "LRAM")
For i = 0 To UBound(MachineNames)
With WS.Cells(WS.Rows.Count, 1).End(xlUp).Offset(1, 0)
.Value = MachineNames(i)
For j = 0 To UBound(WSNames)
.Offset(0, j + 1).Value = IIf(Sheets(WSNames(j)).Columns("A").Find( _
MachineNames(i), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing, "no", "yes")
Next
End With
Next
WS.Columns.AutoFit
Application.ScreenUpdating = True
Unload UserForm5
Unload frmExtract
End SubMatt

itipu
03-21-2007, 11:39 AM
It runs perfect on the test.xls, but not in a real spreadsheet I have ;(

If I do a Union of 4 spreadsheets machine names, it is around 17000 entires and if you remove duplicates (union) it goes down to around 7000... but for those 7000 to get yes/no's it I guess takes a very long while..... at least so far it still runs, about 15min now...

Thanks a lot

Mike

itipu
03-21-2007, 11:40 AM
Hmm... restarted it, and now only took about a minute ;)

oh well... it works perfect!!!!!!!!!!

Thanks a lot a lot a lot!!!!

Mike

itipu
03-21-2007, 11:43 AM
I don't think it deletes duplicates correctly!!!... when I sued my little delete function the union of 4 sheets was arund 7000... now I am getting 10000... I picked a random machine and made a searcg and found the record twice :)

Little bug?

Thanks

Mikey

mvidas
03-21-2007, 11:54 AM
The only way there would be duplicates in there is if there are actual differences in the machine names, case included. For example "MACHINE1" is not the same as "MAchINE1", " MACHINE1" (space before the name), or "MACHINE1 " (space after the name). I assumed you were running queries to populate those sheets, so only the true machine name would be returned.

What the code does is create an array to hold the machine names, look at the machine names on every worksheet to be examined, if the machine name is not already in the array then it gets added, otherwise it gets skipped. There really should be no reason for there to be a duplicate.. I'm a bit confused that there would be!

itipu
03-21-2007, 12:03 PM
Yeap... it is the upper lower case issue... if I add my del function back it removes irrelevant of case... yours only removes items of same case... any way to fix that? or of course I can use mine Del unction...if I add it, I again get only 7000 which looks better!

Thanks

itipu
03-21-2007, 12:12 PM
just noticed if I use my Del function it removes duplicates in Column A ok, but then Columns B, C , D & E are way too long...

mvidas
03-21-2007, 12:12 PM
There sure is a way, depending on how you want it to look at the end.

Do you want it to be all upper or lower case on your summary sheet? If so, change the line (both times it appears):'MachName = CLL.Text
'to:
MachName = UCase(CLL.Text) 'all upper case
'or
MachName = LCase(CLL.Text) 'all lower case

Your other option would be to make the following change (again, this line appears twice in the code, you'll need to change both):'If MachineNames(j) = MachName Then Exit For
If LCase(MachineNames(j)) = LCase(MachName) Then Exit ForWhat that will do is show whichever came first on your Summary worksheet, but will view "MACHINE1" and "machine1" as the same. This is probably the way you'll want to view it, though standardizing the case (the first option) is not a bad way either.

Matt

itipu
03-22-2007, 07:23 AM
Thanks a lot, works great!

The only funny thing I 've noticed, if I open something else while this macro is running it hangs and never comes back...

I got some other once, and usually if you lets say open IE your Excel kind of does not respond for a while, but once it is done processsing it comes back up again...

However with this one it just hangs.... any idea why?

Thanks

Mikey

mvidas
03-22-2007, 07:38 AM
Hmmm... not quite sure in all honesty. What you could do (and for processing this big would probably be better), is add "doevents" in some of the loops.

Near the end is the line:
For j = 0 To UBound(WSNames)
Directly after that, add:
DoEvents

Do the same after both instances of the line:
For Each CLL In WS.Range("A2", WS.Cells(WS.Rows.Count, 1).End(xlUp)).Cells

Should make your system respond better while the macro is running. As to why it just hangs, I have no idea. If you press ctrl-break while it is just hanging (to break the macro), what line does it go to if you click Debug?

itipu
03-22-2007, 08:38 AM
That seems to fix the issue!!!

Thanks a million once again!

Mike