Dear All,

Can you help me with this rather simple VBA code. I have a column on
my worksheet containing the text "Numbers". The position of this
column can vary in every worksheet sometimes it can be B20 sometimes
D23 and so on.

All I want to do is
1. Find the Column which contains text "Numbers" and "Total" to define
start and end range
2. Position to the exact row below this founded column
3. Since, it comprises of numbers, i want to know how many times a
number is appearing

Example -
H
21 Numbers
22 2323
23 2323
24 2324
25 2323
26 2324
27 2329
28 2320
29 2323
30 2324
31 Total = 9

Hence my answer should be writtten in new worksheet as

A B
1 Number Count
2 2323 4
3 2324 3
4 2329 1
5 2320 1

Can you please provide me with the code for this. The row and column
with the Text "Numbers" can vary in every spreadsheet but it is
certain that it will end with "Total", so i believe that start row
should be row +1 where text "Numbers" appear and endRow should be row
-1 where Text "Total" appears. Also, the list of numbers can be more
or less demonstarted in example.

Many Thanks in advance...

The following will copy all the numbers to the new sheet (Col A) and
put your desired result in Cols B & C. If you don't want the extra
column, use the menu Copy | Paste Special | Values with Cols B & C as
both source and destination. Then delete Col A. Of course, you could
record a macro while doing so and add the code at the end of this.

Sub Macro1()
Dim rng1 As Range
Dim rng2 As Range
Dim iEnd As Integer

Sheets("Sheet1").Activate
Set rng1 = Cells.Find(What:="Numbers", after:=Range("A1"),
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set rng2 = Cells.Find(What:="Total", after:=rng1,
LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False)
Set rng1 = Range(rng1, rng2.Offset(-1, 0))
Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count) )
rng1.Copy
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1:A" & rng1.Rows.Count + 1).AdvancedFilter
Action:=xlFilterCopy, _
CopyToRange:=Range("B1"), Unique:=True
Set rng1 = Range("A2:A" & rng1.Rows.Count)
iEnd = Range("B1").End(xlDown).Row
Set rng2 = Range("C2:C" & iEnd)
Range("C2").Formula = "=COUNTIF(" & rng1.Address & ",B2)"
Range("C2").Copy rng2
Range("C1") = "Count"
End Sub

Hth,
Merjet

Hi

This method should work for you though it can probably be done quicker
and easier, but I tested it with your example and it seemed to work.

It will search for "numbers" and "total=" in sheet1 and when found it
will use them to set your range. It will then move through the range
calculating the details and adding them to sheet2.

Option Explicit
Dim FstCell, LstCell As String
Dim MyCell, MyRng As Range
Dim FndCell As Boolean

Private Sub CommandButton1_Click()
Sheets(1).Activate
Cells.Find(What:="numbers", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole).Activate 'Find the cell containing the word
numbers
FstCell = ActiveCell.Offset(1, 0).Address 'set that cell
address to a string
Cells.Find(What:="total=", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart).Activate 'Find the cell containing the word total
LstCell = ActiveCell.Offset(-1, 0).Address 'set that cell
address to a string

Set MyRng = Range(FstCell, LstCell) 'Set the range
Sheets(2).Activate 'change to sheet 2
[a2].Select 'activate the second cell in column A
For Each MyCell In MyRng 'start to iterate through the cells in your
range

On Error Resume Next 'add this to prevent an error in the next step

FndCell = Cells.Find(What:=MyCell, LookAt:=xlWhole) 'boolean the
result
If FndCell = True Then
Cells.Find(What:=MyCell, After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlWhole).Activate 'activate that cell and increase the
total by 1
ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0,
1).Value + 1
FndCell = False 'set your boolean to false again
[a2].End(xlDown).Offset(1, 0).Select 'move to next
empty cell in A
Else
ActiveCell.Value = MyCell 'add your ref to active cell
ActiveCell.Offset(0, 1).Value = 1 'indicate that ref was found
once
ActiveCell.Offset(1, 0).Select 'move to next empty call in A
End If

Next MyCell 'move on to the next cell in your range

End Sub


Hope this helps you

S

Hi Merjet & Incidental,

Thanks a million guys, both the methods worked just fine.

You saved the day....

Many Thanks