VBA code to find ranges

M

mrpman97

Board Regular
Joined
Apr 11, 2007
Messages
56
I am trying to write code to find ranges.
Sample data:
CLP 32 21
32
323
32

CLP 54
534
hg
555

CLP
32
23

I want to identify all rows below any CLP starting row and before next CLP. I put space inbetween to empahsis what I am looking for. I can identify the row number which has a CLP but I do not know how to store these numbers. Even better would be to identify ranges of rows below each CLP and before the next CLP. Once I have a range identified I want to eliminate any duplicate rows for that section.
Code so far just identifies rows which CLP

For i = 1 to 100
If cells(i,1) like "*CLP*" then
msgbox "Row is " i
end if
next i
end sub

I need to store row numbers and or get ranges for each of subsets.
Need help
Thanks
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
Try this for data in column "A" starting "A1".
This code will also Delete row Duplicates within sub Ranges.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG24Feb39
[COLOR="Navy"]Dim[/COLOR] rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rv [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] oSt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] oEnd [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] rng = Range(Range("A1"), Range("A" & rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] rng
 c = c + 1
    [COLOR="Navy"]If[/COLOR] InStr(Dn, "CLP") [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] c > 1 [COLOR="Navy"]Then[/COLOR]
            Txt = Txt & ":" & Dn.Offset(-1).Address & "," & Dn.Address
        [COLOR="Navy"]Else[/COLOR]
            Txt = Txt & Dn.Address
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
     [COLOR="Navy"]If[/COLOR] rng.Count = c [COLOR="Navy"]Then[/COLOR] Txt = Txt & ":" & Dn.Address
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Set[/COLOR] rng = Range(Txt)
 c = 0
   Rv = Split(rng.Address, ",")
      ReDim Ray(1 To UBound(Rv) + 1)
   
[COLOR="Navy"]For[/COLOR] n = UBound(Rv) To 0 [COLOR="Navy"]Step[/COLOR] -1
    c = c + 1
    Ray(c) = Rv(n)
[COLOR="Navy"]Next[/COLOR] n
   
[COLOR="Navy"]Set[/COLOR] rng = Range(Join(Ray, ","))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] rng.Areas
      oSt = Val(Split(Split(R.Address, ":")(0), "$")(2))
        oEnd = Val(Split(Split(R.Address, ":")(1), "$")(2))
            [COLOR="Navy"]For[/COLOR] n = oEnd To oSt [COLOR="Navy"]Step[/COLOR] -1
                [COLOR="Navy"]With[/COLOR] Range("A" & n)
                    [COLOR="Navy"]If[/COLOR] Application.CountIf(R, .value) > 1 [COLOR="Navy"]Then[/COLOR]
                        .EntireRow.Delete
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]End[/COLOR] With
            [COLOR="Navy"]Next[/COLOR] n
    [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks
Data is in Column A
Got error message: like method range object failed -line set rng = Range(txt)
Help
 
Upvote 0
I ran my code on the data below , with the folowing Results.
How does your data vary from this.
I quite expected under a different scenario you could get an error, but you need to find the problem to resolve it.
Data
Code: 
[COLOR=royalblue][B]Row No [/B][/COLOR][COLOR=royalblue][B]Col(A)    [/B][/COLOR]
1.      CLP 32 21 
2.      123       
3.      124       
4.      123       
5.      124       
6.      CLP 54    
7.      125       
8.      126       
9.      124       
10.     125       
11.     CLP 456   
12.     32        
13.     23        
14.     32        
15.     CLP       
16.     32        
17.     555       
18.     23        
19.     555
Results
Code: 
[COLOR=royalblue][B]Row No [/B][/COLOR][COLOR=royalblue][B]Col(A)    [/B][/COLOR]
1.      CLP 32 21 
2.      123       
3.      124       
4.      CLP 54    
5.      125       
6.      126       
7.      124       
8.      CLP 456   
9.      32        
10.     23        
11.     CLP       
12.     32        
13.     555       
14.     23
Regards Mick
 
Upvote 0
This is my actual data
NM1*QC*1*STETTIN*HERBERT****MI*0000156664~
DTM*050*20110119~
DTM*232*20110119~
SVC*N4>00093736698*104.7*-.03**30~
DTM*472*20110119~
CLP*9510676*1*249.72*157.05*39.1*13*110032461021010999~
CAS*CO*90*52.07**91*1.5**144*0~
CAS*PR*2*39.1~
NM1*QC*1*FLITCROFT*DANIEL****MI*30220000090001~
DTM*050*20110103~
DTM*232*20110103~
SVC*N4>00069582060*249.72*157.02**60~
DTM*472*20110103~
CLP*9621228*1*132.61*0*81.4*13*110192487060012999~
CAS*CO*90*50.71**91*.5**144*0~
CAS*PR*2*81.4~
NM1*QC*1*STETTIN*HERBERT****MI*0000156664~
DTM*050*20110119~
DTM*232*20110119~
SVC*N4>00008060701*132.61*-.03**30~
DTM*472*20110119~
CLP*9621228*22*-132.61*0*0*13*110192487060012999~
CAS*CR*90*-50.71**91*-.5**144*0**137*0**2*-81.4~
NM1*QC*1*STETTIN*HERBERT****MI*0000156664~
DTM*050*20110119~
DTM*232*20110119~
SVC*N4>00008060701*-132.61*-.03**30~
DTM*472*20110119~
CLP*9621228*1*132.61*0*81.4*13*110263409940010999~
CAS*CO*90*50.71**91*.5**144*0~
CAS*PR*2*81.4~
NM1*QC*1*STETTIN*HERBERT****MI*0000156664~
DTM*050*20110126~
DTM*232*20110126~
SVC*N4>00008060701*132.61*-.03**30~
DTM*472*20110126~
PLB*3958898*20111231*AH*.27*FB*0*CS>02*0*CS>03*0~
SE*83*0001~
GE*1*65~
IEA*1*000000065~
 
Upvote 0
Could you specify which is the Particular value in the List that will divide it into sub groups, and could you also show with that data your expected results after the code has run.
Regards Mick
 
Upvote 0
Any line starting with CLP is the start of the range. All rows below are in the subset until it reaches another CLP row.
So Every row in subset below and CLP row and before the next one, I want to eliminate any duplicates. I will try latter to show you the expected results.
 
Upvote 0
the file I sent did not have any duplicates. I will try to send file with dups
ISA*00* *00* *ZZ*364221427 *ZZ*00000608 *110204*1002*U*00401*000030053*0*P*>~
GS*HP*364221427*00000608*20110204*1002*30053*X*004010X091A1~
ST*835*0001~
BPR*I*7146.76*C*CHK************20110215~
TRN*1*252819*1364221427~
REF*EV*608~
DTM*405*20110215~
N1*PR*MedTrak Services~
N3*7101 College Blvd, Suite 1000~
N4*Overland Park*KS*66210~
REF*EO*800004~
N1*PE*PROCARE PHARMACY DIRECT, INC. DBA*FI*050504251~
N3*PHARMACARE SPECIALTY PHARMACY*PO BOX 99794~
N4*CHICAGO*IL*606967594~
LX*1~
TS3*2636984*99*20111231*7*617.84~
CLP*0036437*1*176.87*14.47*5*13*2663311101056G~
CAS*PR*3*5~
CAS*PR*3*5~
CAS*CO*45*157.4~
NM1*QC*1*WARNER*JEFFREY****MI*341527281-02~
NM1*IL*1*WARNER*TEENA****MI*341527281-02~
NM1*82*2*CARE PLUS CVS PHARMACY*****PC*2636984~
SVC*N4>00143992950*176.87*14.47**28~
DTM*472*20110105~
CAS*PR*3*5~
CAS*CO*45*157.4~
CLP*0033626*1*122.06*72.25*25*13*1588561010220B~
CAS*PR*3*25~
CAS*CO*45*24.81~
NM1*QC*1*GOGUE*BILL****MI*WBA1116778-02~
NM1*IL*1*GOGUE*DARLEEN****MI*WBA1116778-02~
NM1*82*2*CARE PLUS CVS PHARMACY*****PC*2636984~
SVC*N4>00071015523*122.06*72.25**30~
DTM*472*20101022~
CAS*PR*3*25~
CAS*CO*45*24.81~
CLP*0028879*1*24.93*4.75*10*13*1588568010229G~
CAS*PR*3*10~
CAS*CO*45*10.18~
NM1*QC*1*GOGUE*BILL****MI*WBA1116778-02~
NM1*IL*1*GOGUE*DARLEEN****MI*WBA1116778-02~
NM1*82*2*CARE PLUS CVS PHARMACY*****PC*2636984~
SVC*N4>53746027101*24.93*4.75**30~
DTM*472*20101022~
CAS*PR*3*10~
CAS*CO*45*10.18~
CLP*0033626*1*122.06*72.25*25*13*1954367011178B~
CAS*PR*3*25~
CAS*CO*45*24.81~
NM1*QC*1*GOGUE*BILL****MI*WBA1116778-02~
NM1*IL*1*GOGUE*DARLEEN****MI*WBA1116778-02~
NM1*82*2*CARE PLUS CVS PHARMACY*****PC*2636984~
SVC*N4>00071015523*122.06*72.25**30~
DTM*472*20101117~
CAS*PR*3*25~
CAS*CO*45*24.81~
CLP*0028879*1*24.93*4.75*10*13*1954375011177G~
CAS*PR*3*10~
CAS*CO*45*10.18~
NM1*QC*1*GOGUE*BILL****MI*WBA1116778-02~
NM1*IL*1*GOGUE*DARLEEN****MI*WBA1116778-02~
NM1*82*2*CARE PLUS CVS PHARMACY*****PC*2636984~
SVC*N4>53746027101*24.93*4.75**30~
DTM*472*20101117~
CAS*PR*3*10~
CAS*CO*45*10.18~
CLP*0028879*1*24.93*4.75*10*13*2405570012205G~
CAS*PR*3*10~
CAS*CO*45*10.18~
NM1*QC*1*GOGUE*BILL****MI*WBA1116778-02~
NM1*IL*1*GOGUE*DARLEEN****MI*WBA1116778-02~
NM1*82*2*CARE PLUS CVS PHARMACY*****PC*2636984~
SVC*N4>53746027101*24.93*4.75**30~
DTM*472*20101220~
CAS*PR*3*10~
CAS*CO*45*10.18~
CLP*0033626*1*122.06*72.25*25*13*2447218012222B~
CAS*PR*3*25~
CAS*CO*45*24.81~
NM1*QC*1*GOGUE*BILL****MI*WBA1116778-02~
NM1*IL*1*GOGUE*DARLEEN****MI*WBA1116778-02~
NM1*82*2*CARE PLUS CVS PHARMACY*****PC*2636984~
SVC*N4>00071015523*122.06*72.25**30~
DTM*472*20101222~
CAS*PR*3*25~
CAS*CO*45*24.81~
LX*2~
TS3*3958898*99*20111231*4*8854.69~
CLP*9574553*1*112.44*0*10*13*2385665012171G~
CAS*PR*3*10~
CAS*CO*45*102.44~
NM1*QC*1*MCCOY*ROBERT****MI*04689733C-01~
NM1*82*2*PROCARE PHARMACY DIRECT LLC*****PC*3958898~
SVC*N4>00093005805*112.44*0**120~
DTM*472*20101216~
CAS*PR*3*10~
CAS*CO*45*102.44~
CLP*9233837*1*3815.16*3042.06*25*13*2633413101030B~
CAS*PR*3*25~
CAS*CO*45*748.1~
NM1*QC*1*MAY*RHONDA****MI*499606240-02~
NM1*IL*1*MAY*CLARENCE****MI*499606240-02~
NM1*82*2*PROCARE PHARMACY DIRECT LLC*****PC*3958898~
SVC*N4>59627000205*3815.16*3042.06**4~
DTM*472*20110103~
CAS*PR*3*25~
CAS*CO*45*748.1~
CLP*9453831*1*3996.06*3187.59*25*13*2435236012218B~
CAS*PR*3*25~
CAS*CO*45*783.47~
NM1*QC*1*GILPIN*PATRICIA****MI*CP0014118-02~
NM1*IL*1*GILPIN*MICHAEL****MI*CP0014118-02~
NM1*82*2*PROCARE PHARMACY DIRECT LLC*****PC*3958898~
SVC*N4>68546031730*3996.06*3187.59**1~
DTM*472*20101221~
CAS*PR*3*25~
CAS*CO*45*783.47~
CLP*9653696*1*931.03*671.64*75*13*2419317012201B~
CAS*PR*3*75~
CAS*CO*45*184.39~
NM1*QC*1*DOSS*CARRIE****MI*CT0000299-02~
NM1*IL*1*DOSS*CHARLES****MI*CT0000299-02~
NM1*82*2*PROCARE PHARMACY DIRECT LLC*****PC*3958898~
SVC*N4>50419042101*931.03*671.64**1~
DTM*472*20101220~
CAS*PR*3*75~
CAS*CO*45*184.39~
SE*126*0001~
GE*1*30053~
IEA*1*000030053~
 
Upvote 0
Try this:-
The previous code , didn't like the "~".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG25Feb39
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rv [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] oSt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] oEnd [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
Application.ScreenUpdating = False
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
 c = c + 1
    [COLOR="Navy"]If[/COLOR] InStr(Dn, "CLP") [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] c > 1 [COLOR="Navy"]Then[/COLOR]
            Txt = Txt & ":" & Dn.Offset(-1).Address & "," & Dn.Address
        [COLOR="Navy"]Else[/COLOR]
            Txt = Txt & Dn.Address
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
     [COLOR="Navy"]If[/COLOR] c = 1 And Not InStr(Dn, "CLP") [COLOR="Navy"]Then[/COLOR] Txt = Txt & Dn.Address
     [COLOR="Navy"]If[/COLOR] Rng.Count = c [COLOR="Navy"]Then[/COLOR] Txt = Txt & ":" & Dn.Address
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Set[/COLOR] Rng = Range(Txt)
c = 0
   Rv = Split(Rng.Address, ",")
      ReDim Ray(1 To UBound(Rv) + 1)
   
[COLOR="Navy"]For[/COLOR] n = UBound(Rv) To 0 [COLOR="Navy"]Step[/COLOR] -1
    c = c + 1
    Ray(c) = Rv(n)
[COLOR="Navy"]Next[/COLOR] n
   
[COLOR="Navy"]Set[/COLOR] Rng = Range(Join(Ray, ","))
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Rng.Areas
      oSt = Val(Split(Split(R.Address, ":")(0), "$")(2))
        oEnd = Val(Split(Split(R.Address, ":")(1), "$")(2))
            [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
                .CompareMode = vbTextCompare
                [COLOR="Navy"]For[/COLOR] n = oEnd To oSt [COLOR="Navy"]Step[/COLOR] -1
                    [COLOR="Navy"]If[/COLOR] Not .Exists(Range("A" & n).value) [COLOR="Navy"]Then[/COLOR]
                            .Add Range("A" & n).value, ""
                        [COLOR="Navy"]Else[/COLOR]
                            Range("A" & n).EntireRow.Delete
                        [COLOR="Navy"]End[/COLOR] If
                 [COLOR="Navy"]Next[/COLOR] n
            [COLOR="Navy"]End[/COLOR] With
   [COLOR="Navy"]Next[/COLOR] R
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Solved
Most Consecutive appearances in a range
2 3
Replies
27
Views
337
Fluff
Fluff
C
  • Question Question
VBA code to select all columns contain any data in specific row
Replies
2
Views
343
Peter_SSs
Peter_SSs
A
  • Question Question
Dynamically add new rows via VBA when using IFERROR TEXTJOIN and FILTER formulas from Table?
Replies
0
Views
529
AlfredDB
A
E
  • Solved
Syntax problem with SumProduct and range?
2
Replies
16
Views
566
EssKayKay
E
W
  • Question Question
Creating a 'Reset' button for a text form, plus additional buttons
Replies
2
Views
291
WEB78
W

Forum statistics

Threads
1,224,522
Messages
6,179,297
Members
452,903
Latest member
Knuddeluff

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top