how to return "summary" of all non-blank cells plus their headers

[Karin S]

I have a table with badge names across the top (240 of them!) and people names down the left (50 of them). Most of the cells in the table are blank, but some have a date in them, and some have a percentage.

For each person, I'd like to show a "summary" cell that includes any cell with a percentage, along with the corresponding badge name, as well as any cell after a certain date, along with the corresponding badge names. And forthe date cells, I'd love to display 100% instead of the date.

For example, one person's "summary" might look like this:
Cycling 66%, Fire Building 38%, Heroes 50%, Photography 100%

The only way I can think of to do this is to make 240 MORE columns of IF statements (along the lines of =IF(B2>$A$1,B1&": 100% ",IF(B2="","",IF(B2>1,"",B1&": "&TEXT(B2,"0%")))) copied over and down) and then make a summary cell of =IH1&II1&IJ1&IK1&IL1& 235 more cell references typed in individually!

Please tell me there's a better way! : )

Thanks for any suggestions.
-Karin

 

[Claus Busch]

Hi Karin,

Am Tue, 12 Nov 2013 07:30:48 -0800 (PST) schrieb Karin S:

I have a table with badge names across the top (240 of them!) and people names down the left (50 of them). Most of the cells in the table are blank, but some have a date in them, and some have a percentage.

For each person, I'd like to show a "summary" cell that includes any cell with a percentage, along with the corresponding badge name, as well as any cell after a certain date, along with the corresponding badge names. And for the date cells, I'd love to display 100% instead of the date.

For example, one person's "summary" might look like this:
Cycling 66%, Fire Building 38%, Heroes 50%, Photography 100%

copy your names to Sheet2 column A. Paste following code in a standard
module and run it (modify sheet names and ranges if necessary):

Sub Test()
Dim LRow As Long
Dim LRow2 As Long
Dim myRow As Long
Dim LCol As Integer
Dim c As Range
Dim rngC As Range
Dim firstaddress As String
Dim myStr As String

LRow2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Sheet1")
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For Each rngC In Sheets("Sheet2").Range("A1:A" & LRow2)
myStr = ""
myRow = .Range("A2:A" & LRow).Find(rngC, LookIn:=xlValues).Row
Set c = .Range(.Cells(myRow, 2), .Cells(myRow, LCol)) _
.Find("*", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
myStr = myStr & .Cells(1, c.Column) & " " & _
IIf(c.Value > 1, Format(1, "0%"), _
Format(c.Value, "0.00%")) & ", "
Set c = .Range(.Cells(myRow, 2), .Cells(myRow, LCol)) _
.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
If Len(myStr) > 0 Then
rngC.Offset(, 1) = Left(myStr, Len(myStr) - 2)
End If
Next
End With
End Sub


Regards
Claus B.

 

[Karin S]

Thanks for posting, Claus. Unfortunately, I get a "Run-time error 91: Object variable and With block variable not set". But thus far, the only VBA I've done is recording macros and then slightly editing them sometimes.

I *think* I have "test" in the right place -- when I click the "Macros" button, I see it listed and then clicked the Run button.

I wasn't sure which ranges to possibly edit. I did make sure my Sheets werenamed Sheet1 and Sheet2 and I put my names in column A, starting in A2.

Also, does this find only the cells with percentages? I didn't see a place where it asked for a date, so it could find all cells with a date AFTER theentered date and mark only those as 100%. (Or if it's easier, we could leave the percentage of the date ones, just list the heading.)

Again, thanks for your help thus far!

-Karin

 

[Karin S]

Thanks for posting, Claus. Unfortunately, I get a "Run-time error 91: Object variable and With block variable not set". But thus far, the only VBA I've done is recording macros and then slightly editing them sometimes.



I *think* I have "test" in the right place -- when I click the "Macros" button, I see it listed and then clicked the Run button.



I wasn't sure which ranges to possibly edit. I did make sure my Sheets were named Sheet1 and Sheet2 and I put my names in column A, starting in A2.



Also, does this find only the cells with percentages? I didn't see a place where it asked for a date, so it could find all cells with a date AFTER the entered date and mark only those as 100%. (Or if it's easier, we could leave the percentage of the date ones, just list the heading.)



Again, thanks for your help thus far!



-Karin

Sorry, reading through the VBA again, I realized I needed to move my names on Sheet2 to start in A1, instead of A2!

Then it worked super! Only problem is that it's pulling in ALL cells with adate. As mentioned above, I want to be able to input a date and only include dates after the entered one.

Care to tweak the VBA for me? : )

Karin

 

[Claus Busch]

Hi Karin,

Am Tue, 12 Nov 2013 08:53:42 -0800 (PST) schrieb Karin S:

Thanks for posting, Claus. Unfortunately, I get a "Run-time error 91: Object variable and With block variable not set". But thus far, the only VBA I've done is recording macros and then slightly editing them sometimes.

I *think* I have "test" in the right place -- when I click the "Macros" button, I see it listed and then clicked the Run button.

I wasn't sure which ranges to possibly edit. I did make sure my Sheets were named Sheet1 and Sheet2 and I put my names in column A, starting in A2.

Also, does this find only the cells with percentages? I didn't see a place where it asked for a date, so it could find all cells with a date AFTER the entered date and mark only those as 100%. (Or if it's easier, we could leave the percentage of the date ones, just list the heading.)

have the sheets the correct names or have you changed the sheet names
into the code.
Please have a look here:
https://skydrive.live.com/#cid=9378AAB6121822A3&id=9378AAB6121822A3!326
for the workbook "Summary"
If have only 5 columns but that is enough for testing.
The macro finds all cells with values and write 100% if it is a date and
the correct % value if it is %. But you can see it.


Regards
Claus B.

 

[Claus Busch]

Hi Karin,

Am Tue, 12 Nov 2013 08:56:18 -0800 (PST) schrieb Karin S:

Then it worked super! Only problem is that it's pulling in ALL cells with a date. As mentioned above, I want to be able to input a date and only include dates after the entered one.

I changed it in the workbook "Summary". Please have another look and
download it, because macros are disabled in SkyDrive


Regards
Claus B.

 

[Karin S]

I changed it in the workbook "Summary". Please have another look and
download it, because macros are disabled in SkyDrive

Regards

Claus B.

Super!!

It wasn't showing the headings for the percentages anymore, but I was able to fix that myself by copying and pasting [ .Cells(1, c.Column) & " " & ] to the appropriate spot.

Also, my badge names don't actually start until Column CV, the 100th column, so I changed 2 to 99 in both instances of [ set c = .Range(.Cells(myRow, 99), .Cells...] and it worked!

But could you possibly confirm that I did that correctly? I tried various scenarios to make sure I was changing the correct numbers, and everything seemed to check out. The only curiosity was that, if there was a correct dateor percentage under the FIRST badge name (in column CV), it showed up at the END of the summary.

Anyway, thank you, thank you, Claus, for all your help with this. This willmake my reporting SO much easier!!! (And I learned a bit more VBA in the process.)

-Karin

p.s. Final code:
Sub SummaryInfo()
Dim LRow As Long
Dim LRow2 As Long
Dim myRow As Long
Dim LCol As Integer
Dim c As Range
Dim rngC As Range
Dim firstaddress As String
Dim myStr As String
Dim myDate As Double

LRow2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Sheet1")
myDate = Application.InputBox("Enter a date", "Date", Type:=1)
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For Each rngC In Sheets("Sheet2").Range("A2:A" & LRow2)
myStr = ""
myRow = .Range("A2:A" & LRow).Find(rngC, LookIn:=xlValues).Row
Set c = .Range(.Cells(myRow, 100), .Cells(myRow, LCol)) _
.Find("*", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
If IsDate(c) And c >= myDate Then
myStr = myStr & .Cells(1, c.Column) & " " & Format(1, "0%") &", "
ElseIf Not IsDate(c) Then
myStr = myStr & .Cells(1, c.Column) & " " & Format(c.Value, "0%") & ", "
End If
Set c = .Range(.Cells(myRow, 100), .Cells(myRow, LCol)) _
.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
If Len(myStr) > 0 Then
rngC.Offset(, 1) = Left(myStr, Len(myStr) - 2)
End If
Next
End With
End Sub

 

[Claus Busch]

Hi Karin,

Am Tue, 12 Nov 2013 10:09:01 -0800 (PST) schrieb Karin S:

It wasn't showing the headings for the percentages anymore, but I was able to fix that myself by copying and pasting [ .Cells(1, c.Column) & " " & ] to the appropriate spot.

Also, my badge names don't actually start until Column CV, the 100th column, so I changed 2 to 99 in both instances of [ set c = .Range(.Cells(myRow, 99), .Cells...] and it worked!

sorry while changing the IF-statement for the date I forgot the header.
With your columns everything is ok. Try:

Sub Test()
Dim LRow As Long
Dim LRow2 As Long
Dim myRow As Long
Dim LCol As Integer
Dim c As Range
Dim rngC As Range
Dim firstaddress As String
Dim myStr As String
Dim myDate As Double

LRow2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Sheet1")
myDate = Application.InputBox("Enter a date", "Date", Type:=1)
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For Each rngC In Sheets("Sheet2").Range("A2:A" & LRow2)
myStr = ""
myRow = .Range("A2:A" & LRow).Find(rngC, LookIn:=xlValues).Row
Set c = .Range(.Cells(myRow, 100), .Cells(myRow, LCol)) _
.Find("*", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
If IsDate(c) And c >= myDate Then
myStr = myStr & .Cells(1, c.Column) & " " & _
Format(1, "0%") & ", "
ElseIf Not IsDate(c) Then
myStr = myStr & .Cells(1, c.Column) & " " & _
Format(c.Value, "0.00%") & ", "
End If
Set c = .Range(.Cells(myRow, 100), .Cells(myRow, LCol)) _
.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
If Len(myStr) > 0 Then
rngC.Offset(, 1) = Left(myStr, Len(myStr) - 2)
End If
Next
End With
End Sub


Regards
Claus B.

 

[Claus Busch]

Hi Karin,

Am Tue, 12 Nov 2013 19:17:34 +0100 schrieb Claus Busch:

Format(c.Value, "0.00%") & ", "

so the percentage values are smaller than 1 you have to change the
format like above.


Regards
Claus B.

 

[Claus Busch]

Hi again,

Am Tue, 12 Nov 2013 19:19:45 +0100 schrieb Claus Busch:

so the percentage values are smaller than 1 you have to change the
format like above.

if your names are in column CU you have to change the lines with LRow
and myRow to:
LRow = .Cells(.Rows.Count, 99).End(xlUp).Row
and
myRow = .Range("CU2:CU" & LRow).Find(rngC, LookIn:=xlValues).Row


Regards
Claus B.

 

[Karin S]

Hi again,



Am Tue, 12 Nov 2013 19:19:45 +0100 schrieb Claus Busch:







if your names are in column CU you have to change the lines with LRow

and myRow to:

LRow = .Cells(.Rows.Count, 99).End(xlUp).Row

and

myRow = .Range("CU2:CU" & LRow).Find(rngC, LookIn:=xlValues).Row





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Thanks for your help, Claus. It's all set and works great.