PDA

View Full Version : Unable to solve using macro



abraham30
04-26-2012, 12:09 PM
Hi friends,
Can anybody solve this issue as I am unable to find solution but one of my colleague has done upto some extent.
I need your help.
Query------------
when data to be printed is shifted from H2 to any of the other cell (suppose H20) and some unwanted data are there just below the table, why data are mingledwhile running the macro . How to remove this unwanted record.

p45cal
04-26-2012, 04:59 PM
Your problems hinge around the line:
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
which is the same as selecting the very bottom cell in column A (A1000000+), then pressing the End key on the keyboard, followed by the up-arrow key. Because of the unwanted data below the table, you end up below the bottom of the table and that is taken as the last row of data, so the macro is trying process those extra rows too.

If you have:
1. a continuous run of cells with data in column 1 of what is supposed to be the table and
2. a guarantee of at least one empty cell directly below the table in column A
then you can substitute this line:
For i = 2 To Range("A1").End(xlDown).Row

If you can't guarantee 1 and 2 above, come back and we'll find another way of determining the dimension of the table.

That's it.
However, your code is quite difficult to read, and so is difficult to adjust, so I've taken the liberty of tweaking it a bit:Sub CombineData()
Dim objDic As Object
Dim sStr As String

Set objDic = CreateObject("Scripting.Dictionary")
With objDic
.Comparemode = vbTextCompare

'Defining 8 cases
.Add "Scott Clerk 10", 0
.Add "Scott Clerk 20", 0
.Add "Scott 10000 Sales 10", 0
.Add "Scott 10000 Sales 20", 0
.Add "Tiger New York Clerk 10", 0
.Add "Tiger New York Clerk 20", 0
.Add "Tiger Chicago Clerk 10", 0
.Add "Tiger Chicago Clerk 20", 0

For i = 2 To Range("A1").End(xlDown).Row
Entry1 = Range("B" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value
Entry2 = Range("B" & i).Value & " " & Range("C" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value
Entry3 = Range("B" & i).Value & " " & Range("D" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value
Entry4 = Range("A" & i).Value & "/" & Range("B" & i).Value & "/" & Range("C" & i).Value & "/" & Range("D" & i).Value & "/" & Range("E" & i).Value
myCount = Range("F" & i).Value
Select Case True
Case .exists(Entry1): .Item(Entry1) = .Item(Entry1) + myCount
Case .exists(Entry2): .Item(Entry2) = .Item(Entry2) + myCount
Case .exists(Entry3): .Item(Entry3) = .Item(Entry3) + myCount
Case .exists(Entry4): .Item(Entry4) = .Item(Entry4) + myCount
Case Else: .Add Entry4, myCount
End Select
Next i

zzz = Application.Transpose(Array(.keys, .items))

For i = 1 To UBound(zzz)
zzz(i, 1) = zzz(i, 1) & "=" & zzz(i, 2)
Next i
Range("H2").Resize(UBound(zzz)).Value = Application.Index(zzz, 0)
End With
Set objDic = Nothing
End Sub

abraham30
04-27-2012, 04:41 AM
Thanks a lot p45cal for providing the solution.
Is it possible that we will keep one blank cell below every two records as all record are displayed at a time without blank field.
Scott Clerk 10=15
Scott Clerk 20=4
one blank field
Scott 10000 Sales 10=0
Scott 10000 Sales 20=13
one blank field
Tiger New York Clerk 10=15
Tiger New York Clerk 20=16
one blank field
Tiger Chicago Clerk 10=5
Tiger Chicago Clerk 20=1
one blank field
Sales/Baylish/13000/India/20=1
Clerk/ADAM/10000/India/20=3

I want the unmatched records (separated with slash) in red font. (But the macro keep the first two records in red font which I don't need).

shrivallabha
04-27-2012, 11:14 AM
Original thread is here (http://www.vbaexpress.com/forum/showthread.php?t=41692) where I had written that ugly solution.

Thank you p45cal for providing a better solution and it certainly is legible solution. Some of the guys on this site really amaze me.

It goes without saying, you are one of them:bow:

abraham30
04-27-2012, 11:27 PM
Thanks to both of you as I was not aware that this question has alreday been posted. My colleague asked me but I am not able to solve. However, don't say ballabha that u have provided ugly solution. That is also fine. Some code need to change. Any how combined work provide the best result.

Thanks once again P45 for your great support and ballaba for showing the path. I am sorry on behalf of my colleague.

Can we modify the macro for above requirement.