Solved

Button Separating out like numbers from columns

Posted on 2012-03-26
4
270 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 500 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

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Question has a verified solution.

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

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

770 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