?
Solved

Button Separating out like numbers from columns

Posted on 2012-03-26
4
Medium Priority
?
276 Views
Last Modified: 2012-03-28
I am looking to see how I can capture the numbers of 5, 4, 3, 2, and 1's in columns AJ thru AO.  However, columns (AJ & AK) needs to be combined and column (AL & AM), and (AN & AO) respectively.  Right now I have to do a pivot table to capture this information. My process is to copy and paste for example column AK under AJ prior to doing the pivot table and then AL and AM and so on.  Is there a macro that can be written with a button that can automatically capture this information upon request? Please note that because I am copying column AK (site B) underneath column AJ (site A) the pivot table picks up the name for site A and so on.  Attached are the spreadsheet and an example of desired outcome?
IWARspreadsheet-database-FEB12.xls
Sample-pivot-table-output.xls
0
Comment
Question by:Melbut
  • 2
  • 2
4 Comments
 
LVL 12

Accepted Solution

by:
kgerb earned 2000 total points
ID: 37768598
Hello Melbut,
Try this.  Run the sub Summarize and it will populate the Output sheet.  I think it will do what you want.  Give it a shot and let me know.

Kyle
Sub Summarize()
Dim lFRow As Long, lLRow As Long, sCols(), sAdd As String
Dim i As Long, j As Long
lFRow = 4
ReDim sCols(1 To 3, 1 To 2)
sCols(1, 1) = "AJ"
sCols(1, 2) = "AK"
sCols(2, 1) = "AL"
sCols(2, 2) = "AM"
sCols(3, 1) = "AN"
sCols(3, 2) = "AO"
For i = 1 To 3
    lLRow = Columns(sCols(i, 1) & ":" & sCols(i, 2)).Find("*", SearchDirection:=xlPrevious).Row
    sAdd = sCols(i, 1) & 1 & ":" & sCols(i, 2) & lLRow
    For j = 0 To 5
        Range("rngTot" & i).Offset(j + 1) = CountValues(Range(sAdd), j)
    Next j
Next i
    
End Sub

Function CountValues(rng As Range, lVal As Long) As Long
Dim c As Range, sAdd As String
CountValues = 0
With rng
    Set c = .Find(lVal, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        sAdd = c.Address
        Do
            CountValues = CountValues + 1
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> sAdd
    End If
End With
End Function

Open in new window

Q-27649277-RevA.xlsm
0
 

Author Comment

by:Melbut
ID: 37777204
This looks to be functioning  with no problems.  Thank you!
0
 

Author Closing Comment

by:Melbut
ID: 37777214
Thank you for the quick response!
0
 
LVL 12

Expert Comment

by:kgerb
ID: 37777224
You're welcome.  Glad to help.
Kyle
0

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
Currently, there is an issue with being able to copy values from an external application to a dropdown list in Project Web Access (PWA).  The standard copy and paste methods don't seem to work properly. Here is a way to accomplish this task to s…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…

621 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question