Multiple Worksheet, VBA information detail question

[wamaral]

Here is the link to the example excel file I have uploaded to dropbox:


https://www.dropbox.com/s/rd2pe22l4okjnhv/Example.xlsx


Hopefully someone can help me with this as this is a bit out of my range in VBA knowledge. What I am looking for is a code, that once activated, will either input a text box or add a comment based upon cell values through multiple worksheets. In the example, when the macro is activated on the "Review" sheet A4 the code will scan through the worksheets beginning at "Start" ending at "End" which will look for any value greater than 0 in cells A4 then return value in A1 and A4 in a list. When activated, the desired output is shown below.


Test1 10

Test2 60

Test3 70


(Notice Test4 is not included as the value in cell A4 in "Sheet4" is 0.)


Basically I would like the code to show which numbers are being used in the SUM function with the corresponding cell A1 as a reference. Is it possible to get this desired output in either a text box or cell comment?

 

[Smallman]

Hi Warmaral


This is an interesting problem. I performed something similar a good while ago so have been able to draw on that here.


Anyways I have opted to put the values greater than 0 in a comment in A4 of the Review sheet. I have excluded the Start and End Sheet from the Result in line with your example but can include them no problem. The following is the code and attached is a working copy of the file.

[pre]

Option Explicit

Sub AboveZero()
Dim li As Integer
Dim i As Integer
Dim si As Integer
Dim arr As Variant
Dim str As String

Sheet1.[a4].ClearComments
si = Sheets("end").Index - Sheets("start").Index - 1
ReDim arr(1 To si, 1 To 2)
i = 1

For li = Sheets("start").Index + 1 To Sheets("end").Index - 1
If Sheets(li).[a4] > 0 Then
arr(i, 1) = Sheets(li).[a1]
arr(i, 2) = Sheets(li).[a4]
End If
i = i + 1
Next li

For i = LBound(arr) To UBound(arr)
str = str & arr(i, 1) & ", "
str = str & arr(i, 2) & "," & Chr(10)
Next i

str = Replace(str, ", ,", "")
Sheet1.[a4].AddComment
Sheet1.[a4].Comment.Text Text:=str

End Sub

[/pre]

http://rapidshare.com/files/3736821316/Example%20(7)ms.xlsm


Take care


Smallman

 

[wamaral]

Cheers Smallman,


Although if you are up for it I have one more challenge for you. Instead of making the macro static on just A4, how can I alter it so that any cell selected will add the comments as well? Let's say for instance I run the code on C5, it will go through each page, check to see if C5 is above 0 and will still reference A1 for the first part of the text string. The problem I am having is making the reference points dynamic. Here is some code I have added to yours...

[pre]

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim li As Integer
Dim i As Integer
Dim si As Integer
Dim arr As Variant
Dim str As String
Dim cc As Range

Set cc = Range(Selection.Address)

cc.ClearComments
si = Sheets("end").Index - Sheets("start").Index - 1
ReDim arr(1 To si, 1 To 2)
i = 1

For li = Sheets("start").Index + 1 To Sheets("end").Index - 1
If Sheets(li).[cc] > 0 Then
arr(i, 1) = Sheets(li).[a1]
arr(i, 2) = Sheets(li).[cc]
End If
i = i + 1
Next li

For i = LBound(arr) To UBound(arr)
str = str & arr(i, 1) & ", "
str = str & arr(i, 2) & "," & Chr(10)
Next i

str = Replace(str, ", ,", "")
cc.AddComment
cc.Comment.Text Text:=str

End Sub[/pre]

I set the current cell for clearing and adding the comments but the trouble I'm running into is making the Li

portion of the string dynamic to the same cell as the selected cell.

 

[Smallman]

Hi Wamaral


I am not going to be at my computer for some time. Your selection concept based on selection is simple. Set up a variable that captures selection row and change the [a4]. So Something like;


Dim j as integer


J = selection.row


Now you are in business!!! Watch;


arr(i,2) = Sheets(li).range("a" & j)


You get the idea. Now you are dynamic!


Take care


Smallman

 

[wamaral]

Smallman, you sir are a magician. Thank you so much for the help!

 

[Smallman]

Warmaral


I was on a tennis court and using my iphone when I sent that last post. Thanks for your overly generous description of my capacities.


See you next time.


Smallman

 

[wamaral]

Sorry to bother you again but I have one last request and this case can be officially solved. The results of the string in the comment include spaces where the reference cell is 0. How do I make the string only include the tabs that actually have values instead of essential placing blank spaces in for the 2 variables?


For Example:


Test1 10

Test3 70


Instead of


Test1 10


Test3 70


The reason is that there will be a bunch of tabs and I don't want the list to be extremely long.


I tried to null the variables in the string...

[pre]

For li = Sheets("start").Index + 1 To Sheets("end").Index - 1
If Sheets(li).Range("a" & sr) > 0 Then
arr(i, 1) = Sheets(li).[a1]
arr(i, 2) = Sheets(li).Range("a" & sr)
ElseIf Sheets(li).Range("a" & sr) = 0 Then
arr(i, 1) = vbNullString
arr(i, 2) = vbNullString

[/pre]

But I am still getting the long list, I know there is something else I am missing, like I said before my VBA skills are novice at best.


Thanks again for all the help on this so far

 

[Smallman]

Hi Wamaral


Just change the second loop in the original post of mine to this;

[pre]

For i = LBound(arr) To UBound(arr)
If arr(i, 2) > 0 Then
str = str & arr(i, 1) & ", "
str = str & arr(i, 2) & "," & Chr(10)
End If
Next i

[/pre]

That will ignore all of the blanks all together. Should put you well on your way.


Take care


Smallman