After Getting the Range Address of Each Red Thick Border Marked I would like to get the range address of Blue Thick Border marked.

[SamDsouza]

Hello

Title of thread is clear. Attaching the image

With the below code at a point I am able to get range address of Each Red Thick Border Mark on combobox ie address of Formulated Serial Nos

Private Sub UserForm_Initialize()
  Load UserForm1
  UserForm1.Show vbModeless
  Call GetRangeFormualtedSrNo
End Sub

Public Sub GetRangeFormualtedSrNo()

Dim wks1 As Worksheet
Set wks1 = Worksheets("Sheet1")
Dim rngAddString As String

  Dim Ray() As String
  Dim C As Range, LastA As Range, rng As Range
  Dim rws As Long, k As Long, idx As Long
  wks1.Activate
  Set LastA = wks1.Range("A" & Range("C" & Rows.Count).End(xlUp).Row)
  For Each C In wks1.Range("A4", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlFormulas)
    rws = 1
    If IsEmpty(C.Offset(1).Value) And C.Address <> LastA.Address Then rws = rws + Range(C, LastA).SpecialCells(xlBlanks).Areas(1).Rows.Count
    k = k + 1
    ReDim Preserve Ray(1 To k)
       Ray(k) = C.Resize(rws, 3).Address(0, 0)
  Next C
     ComboBox1.List = Ray
     ComboBox1.Text = Ray(1)
End Sub

Following Results

Serial Nos	Formulated Range in Combobox List	Remarks
1	A4:C7
2	A8:C10
3	A11:C12
4	A13:C13
5	A14:C22	Actually this should display as A14:C14. I don’t know why this is happening. Will be glad if this range is not displayed in combobox

After the above corrections somewhere I would like to display another range after the above each formulated SR.Nos range in combobox like below

Serial Nos	Formulated Range	Combobox to display as Marked in Bold
1	A4:C7	A4:C7 A16: C22 where in the range A16:C22 column C includes words Optional Offers
2	A8:C10	A8:C10 A16: C22 where in the range A16:C22 column C includes words Optional Offers
3	A11:C12	A11:C12 A16: C22 where in the range A16:C22 column C includes words Optional Offers
4	A13:C13	A13:C13 A16: C22 where in the range A16:C22 column C includes words Optional Offers
5	A14:C23 corrections to A14:C14	A14:C14 A16: C22 where in the range A16:C22 column C includes words Optional Offers

Excuse me if this too lengthy.
Am really struggling to get Blue marked range address after Each Red marked border Range Address for last couple of days.

Shall be really grateful to you
SamD
110

 

[NimishK]

Hi SamD

Try the following.

I've put the msgbox for you to see the different range Addresses As per your requirement of Blue Marked Borders and Red Marked Borders. Because many times msgbox helps us for better looping and also explained in below code

Public Sub GetRangeFormualtedSrNo()

Dim wks1 As Worksheet
Set wks1 = Worksheets("Sheet1")
Dim rngAddString As String

  Dim Ray() As String
  Dim srNoRng As Range, LastA As Range, rng As Range, cCurRegnRng As Variant, rngFindOptOff As Range,
  Dim rws As Long, k As Long, idx As Long, emptyRow As Long, rngOptOffers As Range

  wks1.Activate
  Set LastA = wks1.Range("A" & Range("C" & Rows.Count).End(xlUp).Row)
  For Each srNoRng In wks1.Range("A4", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlFormulas)
    rws = 1
    If IsEmpty(srNoRng.Offset(1).Value) And srNoRng.Address <> LastA.Address Then rws = rws + Range(srNoRng, LastA).SpecialCells(xlBlanks).Areas(1).Rows.Count
    k = k + 1
    ReDim Preserve Ray(1 To k)
    Ray(k) = srNoRng.Resize(rws, 3).Address(0, 0)
    cCurRegnRng = srNoRng.CurrentRegion.Address
    ' [B][I]cCurRegnRng this will give you full address from header uptil the first blank row for eg A3 to C22[/I][/B]
   
          Set rngFindOptOff = wks1.Range(cCurRegnRng).Find("Optional Offers", LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
     
        '[B][I]to get range address of rngFindOptOff in range(A3:C22) where you will find string "Optional Offers"[/I][/B]

       If rngFindOptOff Is Nothing Then
          MsgBox "Nothing Found"
        Else
                emptyRow = wks1.Range("C" & rngFindOptOff.Row).End(xlDown).Row + 1
                '[B][I] emptyRow which will show uptil First Empty blank row in col C   Added 1 b'cos it will exactly show you address of empty row[/I][/B]
                Set rngOptOffers = wks1.Range("A" & rngFindOptOff.Row & ":A" & emptyRow - 2)
                '[B][I]    'rngOptOffers is range where you want all your items from "Optional Offer" Row uptill the blank row ie why i've deducted 2 [/I][/B]
                   MsgBox "sr No" & srNoRng.Value & vbCrLf & "Full Range " & cCurRegnRng & vbCrLf & "Optional Offer in Row : " & rngFindOptOff.Address & vbCrLf & rngFindOptOff & vbCrLf & "Empty Row = " & emptyRow & vbCrLf & "Range Address: " & rngOptOffers.Offset(1).Address
       End If
    Next srNoRng
  
     ComboBox1.List = Ray
     ComboBox1.Text = Ray(1)
     rngAddString = ComboBox1.Text
  
End Sub

NimishK

 

[SamDsouza]

NimishK
.
God Bless you
Mind-Blowing one ! Man. Superb
I really dont know how to thank you. This is the reference i was wanting.
And with your simple explanation. I am now able to grasp the concept of range addresses

After so much struggle you were the First one to reply. So much exited ! Man
You really made my day.

Thank you Thank you Thank you so much
??
SamD
111