Counting same numbers in different columns.

dixon1983

Board Regular
Joined
Apr 23, 2005
Messages
175
Hi,
I get a report each day that has an unique field.

Each day I copy the column that holds the unique field into a master sheet. Each column in this sheet is labelled with the corresponding date.

I would like to see how long each ID appears on the report.

Is there a way to do a count of how many columns each ID appears in?

Ideally I would like a report page which lists the ID and how many days (columns) this was on the report for. (or even returning the start date and the last date it was on the report - im probably pushing my luck here tho!)

Hope someone can help.

Thanks
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

sweater_vests_rock

Well-known Member
Joined
Oct 8, 2004
Messages
1,657
hi dixon.

i think this should work for you. be sure to change the value of wsData to the worksheet containing your ID data. also, if your Dates are not in row 1 on this worksheet, you'll need to edit the line

Code:
c.Offset(0, 1).Value = wsData.Cells(1, rngFind.Column).Value

replacing the second occurence of 1 with the appropriate row #.

cheers. ben.

Code:
Sub GetLastDate()

    Dim wsData As Worksheet
    Dim rngData As Range, rngFind As Range
    Dim i As Long
    
    On Error GoTo EH:
    Set wsData = Worksheets("Sheet2")
    
'   Get data range of search values from user
    Set rngData = Application.InputBox( _
        Prompt:="Select data to search for: ", _
        Title:="Get Search Data", _
        Default:=ActiveCell.CurrentRegion.Address, _
        Type:=8)
        
    Application.ScreenUpdating = False
    
'   Search for each value from rngData in the dataset (wsData.UsedRange)
    For Each c In rngData.Cells
        Set rngFind = wsData.UsedRange.Find( _
            What:=c.Value, _
            LookIn:=xlValues, _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlPrevious)
        
'       Print column header for last found value to adjacent cell
        c.Offset(0, 1).Value = wsData.Cells(1, rngFind.Column).Value
    Next c

EH:
    Application.ScreenUpdating = True
    Set wsData = Nothing
    Set rngData = Nothing
    Set rngFind = Nothing
    Set c = Nothing
End Sub
 

barry houdini

MrExcel MVP
Joined
Mar 23, 2005
Messages
20,825
If your id is in A2, dates in D1:IV1 and data in D2:IV1000

this formula will give you the first date

=INDEX(D$1:IV$1,MIN(IF(D2:IV100=A2,COLUMN(D2:IV2)-COLUMN(D2)+1)))

and this the last

=INDEX(D$1:IV$1,MAX(IF(D2:IV100=A2,COLUMN(D2:IV2)-COLUMN(D2)+1)))

both confirmed with CTRL+SHIFT+ENTER
 

dixon1983

Board Regular
Joined
Apr 23, 2005
Messages
175

ADVERTISEMENT

Hi,
I've just found a little problem - not with your replys, with my worksheet.

In order to be able to look through all the data and provide the First and Last dates I need every different ID to be listed in column A.

Is there a way for Column A to list every different value in a range of data? E.g B2:Z200

Or is there a way to copy every value from the table into Column A, Sort it, then delete all duplicates so there is just 1 row for each value.

Thanks for any help.
 

sweater_vests_rock

Well-known Member
Joined
Oct 8, 2004
Messages
1,657
In order to be able to look through all the data and provide the First and Last dates I need every different ID to be listed in column A.

Is there a way for Column A to list every different value in a range of data? E.g B2:Z200

Or is there a way to copy every value from the table into Column A, Sort it, then delete all duplicates so there is just 1 row for each value.

as i thought about your question on the way into work today, i had a feeling this would come up!

one way would be to bring all of your data into a single column, then use advanced filter to produce a list a unique IDs:

Code:
Sub CreateList()
   
    Dim SourceSheet As Worksheet, VectorSheet As Worksheet
    Dim ColumnRange As Range
   
    Dim Prompt As String, Title As String, Default As String
    Dim ReturnType As Integer
    Dim i As Long
   
'   Establish sheet containing data to convert
    Set SourceSheet = ActiveSheet
   
'   Check for pre-existing column vector sheets
    i = 1
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, ws.Name, "Copy of " & SourceSheet.Name) <> 0 Then
            i = i + 1
        End If
    Next ws
   
'   Create a name for the worksheet to contain the column vector
    If i > 1 Then
        SheetName = "Copy of " & SourceSheet.Name & "(" & i & ")"
    Else
        SheetName = "Copy of " & SourceSheet.Name & "(" & i & ")"
    End If
   
'   Check name for appropriate length
    If Len(SheetName) > 32 Then
        SheetName = "Sheet" & ThisWorkbook.Worksheets.Count + 1
    End If
   
'   Get range to convert to column vector
    Prompt = "Select the range you wish to convert to a column vector:"
    Title = "Get Column Range"
    Default = ActiveCell.CurrentRegion.Address
    ReturnType = 8

    On Error Resume Next
    Set ColumnRange = Application.InputBox(Prompt, Title, Default, Type:=ReturnType)
   
    On Error GoTo EH:
   
'   Return "Invalid Range" if no range is selected
    If ColumnRange Is Nothing Then
        MsgBox "Error!  Invalid range!"
        Err.Clear
        GoTo EH:
    End If
   
'   Return "Overflow Error" if too many cells are selected
    If ColumnRange.Cells.Count > 65535 Then
        MsgBox "Overflow error!  No more than 65535 cells may be coverted at once!"
        Err.Clear
        GoTo EH:
    End If
   
'   End program if no data is contained in selection
    If Application.WorksheetFunction.CountA(ColumnRange) = 0 Then
        MsgBox "No data found!"
        Err.Clear
        GoTo EH:
    End If

'   Disable screen refresh to expedite execution
    Application.ScreenUpdating = False
   
'   Create new sheet to contain column vector
    Set VectorSheet = Worksheets.Add
    VectorSheet.Name = SheetName
   
'   Create single column vector (if needed) and create ID list with AdvancedFilter
    If ColumnRange.Columns.Count > 1 Then
        Call CombineColumns(VectorSheet, ColumnRange)
    Else
        ColumnRange.Copy
        With VectorSheet
            .Activate
            .Range("A1").PasteSpecial
            .Range("A1").EntireRow.Insert shift:=xlShiftDown
            .Range("A1").Value = "ID List"
        End With
    End If
        
    Call FilterColumn(VectorSheet.Range("A1").EntireColumn)

EH:
    With Err
        If .Number <> 0 Then
            MsgBox "Error!" & Chr(13) & Chr(13) & _
                "Number: " & .Number & Chr(13) & _
                "Description: " & .Description
        End If
    End With
               
    Application.ScreenUpdating = True
   
    Set VectorSheet = Nothing
    Set SourceSheet = Nothing
    Set ColumnRange = Nothing
   
End Sub

Sub CombineColumns(VectorSheet As Worksheet, ColumnRange As Range)

    Dim MyArray As Variant
    Dim StartCell As Range, EndCell As Range
  
'   Dump data range into array to expedite processing
    MyArray = ColumnRange
   
    With VectorSheet
'       Find first and last cell in the dataset
        Set StartCell = .Cells(LBound(MyArray, 1), LBound(MyArray, 2))
        Set EndCell = .Cells(UBound(MyArray, 1), UBound(MyArray, 2))

'       Transpose data
'        Application.WorksheetFunction.Transpose (MyArray)
        
'       Dump array back into the worksheet
        .Range(StartCell, EndCell) = MyArray
        
'       Copy columns into first column to create single column vector
        For i = 2 To UBound(MyArray, 2)
            .Range(.Cells(LBound(MyArray, 1), i), .Cells(UBound(MyArray, 1), i)).Copy
            StartCell.Offset(UBound(MyArray, 1) * (i - 1), 0).PasteSpecial
        Next i
       
'       Insert Header Row
        .Range("A1").EntireRow.Insert shift:=xlShiftDown
        .Range("A1").Value = "ID List"
       
    End With

'   Delete other columns
    StartCell.Offset(0, 1).Resize(1, UBound(MyArray, 2)).EntireColumn.Delete
   
End Sub

Sub FilterColumn(MyColumn As Range)

    MyColumn.AdvancedFilter xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
    MyColumn.Delete
   
End Sub
updated code 10.10.06
 

dixon1983

Board Regular
Joined
Apr 23, 2005
Messages
175

ADVERTISEMENT

Thanks Sweater.

Ive tried to use the Macro but keep gettin an error message saying :

"Error!
Number: 1004
The extract range has a missing or illegal field name"


It gets as far as creating a new sheet and copying the data from the columns selected into it - but no further.

Can you offer any suggestions??

Thanks in advance for any help.
 

sweater_vests_rock

Well-known Member
Joined
Oct 8, 2004
Messages
1,657
dixon.

Ive tried to use the Macro but keep gettin an error message saying :

"Error!
Number: 1004
The extract range has a missing or illegal field name"

i've updated the program above with a few more error checks. i'm having trouble reproducing your error. as an FYI, the code produces a header row named "ID List" -- you'll want to avoid selecting the headers in your range to filter.

let me know if you continue to have issues.
ben.
 

dixon1983

Board Regular
Joined
Apr 23, 2005
Messages
175
dixon.

Ive tried to use the Macro but keep gettin an error message saying :

"Error!
Number: 1004
The extract range has a missing or illegal field name"

i've updated the program above with a few more error checks. i'm having trouble reproducing your error. as an FYI, the code produces a header row named "ID List" -- you'll want to avoid selecting the headers in your range to filter.

let me know if you continue to have issues.
ben.


hi Ben,
I've tried the new code you posted and am still finding the same error, I dont know enought about VB to locate the problem in the code myself.

The error is the same as above. The data gets copied from the data range I select in the pop up window and gets copied into the new sheet. The error seems to occur when the Code only selects the last column of data copied + the cell above it.
E.g I select 5 columns of data, this is copied into the new sheet and the code highlights the last column (E) of data plus the bottom cell of Column D.

Hope you can help.
Thanks for the time youve spent on this.
 

sweater_vests_rock

Well-known Member
Joined
Oct 8, 2004
Messages
1,657
hi dixon.

i still can't get the error -- could you share part of the workbook with me? also, two more things to try (per a thread in the Google Groups)

try updating the last routine (FilterColumn) with this code:
Code:
Sub FilterColumn(MyColumn As Range)

    MyColumn.AdvancedFilter xlFilterCopy, CriteriaRange:=MyColumn, CopyToRange:=Range("B1"), Unique:=True
    MyColumn.Delete
    
End Sub

if that doesn't work, try commenting out the insert header section in the combine columns routine:
Code:
'       Insert Header Row
        '.Range("A1").EntireRow.Insert shift:=xlShiftDown
        '.Range("A1").Value = "ID List"

please note that dropping this header row may result in the duplication of your first ID (excel should treat it as a header for filtering purposes, rather than an entry in the list).
 

Watch MrExcel Video

Forum statistics

Threads
1,111,596
Messages
5,541,150
Members
410,543
Latest member
ExcelGlenn
Top