I think you will need to post an example of your data before the macro does anything and what you want after the macro does its thing (and tell us where you want it). The add-in shown in my signature line could help you in this unless you have method of posting a sample workbook.I have code to search down a column for a range of rows now i need code to take that range and merge it all togeher in
Dim lLastRow As Long '/// A long Variable stores a value between -2,147,483,648 -2,147,483,647\\\\\Dim aSrc As Variant '/// A Variant is a special data type that can contain any kind of data except fixed-length String data. \\\\\
Dim aResults() As String '///item, start row, stop row\\\\
Dim mm As Long, k As Long '/// A long Variable stores a value between -2,147,483,648 -2,147,483,647\\\\\
Dim sCurrVal As String
Dim Rng As Range
lLastRow = Worksheets("Dipole Scratchpad 1").Cells(Sheet1.Rows.Count, "A").End(xlUp).Row '///It is used to find the how many rows contain data in a worksheet that contains data in the column "A". and save it in lLastRow\\\\
aSrc = Worksheets("Dipole Scratchpad 1").Range("A7:A" & lLastRow) '///this is your raw data saved in aSrc\\\\
sCurrVal = aSrc(1, 1) '///set current item,store array in sCurrVal\\\\
ReDim aResults(1 To 3, 1 To 1) '///create result array\\\
aResults(1, 1) = sCurrVal
aResults(2, 1) = 7 'assumes your data starts in row 1
k = 1 'result counter
For i = 1 To UBound(aSrc, 1)
If aSrc(i, 1) <> sCurrVal Then
'write stop row value
aResults(3, k) = i + 5
'set new search item
sCurrVal = aSrc(i, 1)
'load result array
k = k + 1
ReDim Preserve aResults(1 To 3, 1 To k)
aResults(1, k) = sCurrVal
aResults(2, k) = i + 6
End If
Next i
aResults(3, k) = i + 6 'this will capture the last entry
'now write result array to worksheet in 3 columns
Worksheets("Dipole Scratchpad 1").Range("K1").Resize(k, 3) = Application.Transpose(aResults)
Worksheets("Dipole Scratchpad 1").Activate
Dim x As Long
Dim y As Long
For x = 1 To Range("K" & Rows.Count).End(xlUp).Row
If Range("K" & x) = "" Then
y = Range("K" & x).Row
Exit For
End If
Next x
AA = Worksheets("Dipole Scratchpad 1").Cells(1, "L").Value
AB = Worksheets("Dipole Scratchpad 1").Cells(1, "M").Value
Range(AA & ":" & AB).Sort Key1:=Range("B7"), Order1:=xlAscending, Header:=xlGuess
851.0125 | 7 | 8 | ||||||||||
860.0125 | 9 | 13 | ||||||||||
51.0125 | Body | 105.00 | 105.0 | 150512 | 868.9875 | 14 | 16 | |||||
51.0125 | Head | 108.00 | 108.0 | 150512 | ||||||||
60.0125 | Head | 82.00 | 82.0 | 150512 | ||||||||
60.0125 | Head | 83.00 | 102.0 | 150512 | ||||||||
60.0125 | Head | 103.00 | 103.0 | 150512 | ||||||||
60.0125 | Body | 104.00 | 104.0 | 150512 | ||||||||
60.0125 | Body | 109.00 | 110.0 | 150512 | ||||||||
68.9875 | Head | 106.00 | 107.0 | 150512 | ||||||||
68.9875 | Body | 111.00 | 111.0 | 150512 | | |||||||
851.0125 | 7 | 8 | ||||||||||
860.0125 | 9 | 13 | ||||||||||
51.0125 | Body | 105.00 | 105.0 | 150512 | 868.9875 | 14 | 16 | |||||
51.0125 | Head | 108.00 | 108.0 | 150512 | ||||||||
60.0125 | Body | 82.00 | 82.0 | 150512 | ||||||||
60.0125 | Body | 83.00 | 102.0 | 150512 | ||||||||
60.0125 | Head | 103.00 | 103.0 | 150512 | ||||||||
60.0125 | Head | 104.00 | 104.0 | 150512 | ||||||||
60.0125 | Head | 109.00 | 110.0 | 150512 | ||||||||
68.9875 | Body | 106.00 | 107.0 | 150512 | ||||||||
68.9875 | Head | 111.00 | 111.0 | 150512 | ||||||||
[COLOR="Navy"]Sub[/COLOR] MG16Jun36
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not Dn.Value = "" [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
.Add Dn.Value, Dn
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
.Item(K).Offset(, 1).Sort .Item(K).Offset(, 1)(1), xlAscending
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]