rng propblem

[Patrick C. Simonds]

The first 2 lines of code below

What I am wondering is if the code below could be modified in some way to
where as it finds the first occurrence of NoXXX if assigns the variable rng1
and then Set rng1 = Cells(ActiveCell.Row, 1), and then loop to the next
occurrence of NoXXX and set it as rng2 ect.

There can be up to 10 occurrences of NoXXX in column AA. The other part of
the problem is that the last occurrence must be called rng. So if there was
only 1 occurrence of NoXXX it would have to be called rng.

All of this is then used to populate my UserForm with information from each
of the lines.


Sub NextRow()
'
' Macro4 Macro
'

'This routine finds each occurance of NoXXX in column AA so that multipage 2
of NoShowDataInput UserForm can display prior No Shows

Dim c As Range

On Error GoTo Done

ActiveSheet.Columns("AA").Hidden = False

Set c = Cells.Find(What:="NoXXX", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)

If Not c Is Nothing Then
If Intersect(c, Union(Rows("1:" & (ActiveCell.Row + _
(ActiveCell.Row <> 1))), Range("A" & _
ActiveCell.Row & ":" & ActiveCell.Address))) _
Is Nothing Then
c.Select

Else

End If
End If

Done:
ActiveSheet.Columns("AA").Hidden = True

End Sub

 

[Bob Phillips]

Lookup FindNext in help, and use an array of ranges not separate variables,
and make your userform smart enough to interrogate the array.

 

[Per Jessen]

Hi

I would store the the found cells in an array, like this:

Sub NextRow()
'
' Macro4 Macro
'
'This routine finds each occurance of NoXXX in column AA so that
multipage 2 of NoShowDataInput UserForm can display prior No Shows

Dim c As Range
Dim rngArr() As Range
Dim rng As Range
ReDim rngArr(0)
On Error GoTo Done
ActiveSheet.Columns("AA").Hidden = False
Set c = Cells.Find(What:="NoXXX", After:=Range("AA1"),
LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)

If Not c Is Nothing Then
Do
Set rngArr(UBound(rngArr)) = c
ReDim Preserve rngArr(UBound(rngArr) + 1)
Set c = Cells.Find(What:="NoXXX", After:=Range(c.Address),
LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
Loop Until c.Address = rngArr(0).Address
End If
ReDim Preserve rngArr(UBound(rngArr) - 1)
Set rng = rngArr(UBound(rngArr))
Debug.Print rng.Address
Done:
ActiveSheet.Columns("AA").Hidden = True
End Sub

Regards,
Per

 

[Dave Peterson]

I wouldn't name my variables like that. Instead I'd use an array.

Option Explicit
Sub testme04()
Dim Rng() As Range
Dim rCtr As Long
Dim HowMany As Long
Dim myStr As String
Dim FoundCell As Range

myStr = "NoXXX"

With ActiveSheet.Range("aa:aa")
HowMany = Application.CountIf(.Cells, myStr)
If HowMany = 0 Then
MsgBox "No " & myStr & " Found!"
Exit Sub
End If

ReDim Rng(1 To HowMany)

Set FoundCell = .Cells(.Cells.Count)
rCtr = 0
Do
Set FoundCell = .Cells.Find(What:=myStr, _
After:=FoundCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If FoundCell Is Nothing Then
'this shouldn't happen!
Exit Do
Else
rCtr = rCtr + 1
Set Rng(rCtr) = FoundCell
End If

If rCtr = HowMany Then
Exit Do
End If
Loop
End With

If rCtr > 0 Then
For rCtr = LBound(Rng) To UBound(Rng)
MsgBox Rng(rCtr).Address(0, 0)
Next rCtr
End If
End Sub

But I may have changed your intent.

I did that =countif() based on NoXXX--not "Pat's NoXXX data". And I changed the
xlpart to xlwhole to match this.

If you really wanted "Pat's noXXX data", then you could change two lines:

HowMany = Application.CountIf(.Cells, "*" & myStr & "*")
and
LookAt:=xlPart

Actually, you could use excel and the way it treats wild cards and just make one
change:
myStr = "*NoXXX*"

Those asterisk wildcards will mean that =countif() looks anywhere in the cell
and the same with xlWhole.

 

[Patrick C. Simonds]

Thanks.

Originally I had intended to have it set the rng

Set rng2 = Cells(ActiveCell.Row, 1)

each time it found a NoXXX. What I need to do is set a series of TextBox
values based on those ranges

Textbox100.value = rng1(1, 3).value
Textbox101.value = rng1(1, 5).value

Textbox200.value = rng2(1, 3).value
Textbox201.value = rng2(1, 5).value

ect.

So using what you have provided how would /I populate those TextBoxes and
how would /I write data back to those locations?

 

[Dave Peterson]

I just read your followup -- you wanted the cell in column A to be rng().

change:
Set Rng(rCtr) = FoundCell
to
Set Rng(rCtr) = FoundCell.entirerow.cells(1)

 

[Patrick C. Simonds]

I am sorry if I am not being clear

my intent is to populate a number of TextBoxes on my UserForm. So I was
hoping to have your code run at the start of my UserForm Initialization,
identify each of the lines that has an NoXXX and assign a range to it. That
is why I thought I would have to set reach range individually.

Set rng1 = Cells(ActiveCell.Row, 1)
Set rng2 = Cells(ActiveCell.Row, 1)
Set rng3= Cells(ActiveCell.Row, 1) ect....

I thought that I would then be able to continue Initializing my UserForm
based on those ranges, and populate my TextBoxes.

Textbox100.value = rng1(1, 3).value
Textbox101.value = rng1(1, 5).value

Textbox200.value = rng2(1, 3).value
Textbox201.value = rng2(1, 5).value

And then as part of my exit routine write any changed data back to the
worksheet. With your code I do not understand how to initialize my textboxes
or how to write the changes back.

 

[Per Jessen]

Hi

Me.Textbox100=cells(rngArr(0).row,3)
Me.Textbox101=Cells(rngArr(0).Row,5)

Me.Textbox200=cells(rngArr(1).row,3)
Me.Textbox201=Cells(rngArr(1).Row,5)


Regards,
Per

 

[Dave Peterson]

You know how many textboxes you support, right?

You know the pattern of names that are used.

You can move the "dim rng() as variant" to the top of the userform module. Then
it will be able to be seen by each procedure in that module.

But inside the initialize routine, you can use the code I used and then:

Dim hCtr as long
dim tbCtr as long
dim iCtr as long
....

If rCtr > 0 Then
hctr = 0
tbCtr = 0
For iCtr = LBound(Rng) To UBound(Rng)
hctr = hctr + 100

tbctr = 1
me.controls("Textbox" & tctr + tbctr).value = rng(ictr)(1,3)

tbctr = tbctr + 1
me.controls("Textbox" & tctr + tbctr).value = rng(ictr)(1,5)

tbctr = tbctr + 1
me.controls("Textbox" & tctr + tbctr).value = rng(ictr)(1,5)

'and so forth...

Next rCtr


End If

I am sorry if I am not being clear

my intent is to populate a number of TextBoxes on my UserForm. So I was
hoping to have your code run at the start of my UserForm Initialization,
identify each of the lines that has an NoXXX and assign a range to it. That
is why I thought I would have to set reach range individually.

Set rng1 = Cells(ActiveCell.Row, 1)
Set rng2 = Cells(ActiveCell.Row, 1)
Set rng3= Cells(ActiveCell.Row, 1) ect....

I thought that I would then be able to continue Initializing my UserForm
based on those ranges, and populate my TextBoxes.

Textbox100.value = rng1(1, 3).value
Textbox101.value = rng1(1, 5).value

Textbox200.value = rng2(1, 3).value
Textbox201.value = rng2(1, 5).value

And then as part of my exit routine write any changed data back to the
worksheet. With your code I do not understand how to initialize my textboxes
or how to write the changes back.

 

[Patrick C. Simonds]

One more question (I know we always say that)

Can I limit the number of times this loops through looking for occurrences
of NoXXX? I would place the count of NoXXX in cell AA1 (minus 1, I need to
exclude the last occurrence of NoXXX, I modified your code to start its
looking in cell AA7).

 

[Per Jessen]

Isn't there always one more question

Try this one:

Sub NextRow()
'
' Macro4 Macro
'
'This routine finds each occurance of NoXXX in column AA so that
' multipage 2 of NoShowDataInput UserForm can display prior No Shows


Dim c As Range
Dim rngArr() As Range
Dim rng As Range
ReDim rngArr(0)
Dim Counter As Long

On Error GoTo Done
ActiveSheet.Columns("AA").Hidden = False
Set c = Cells.Find(What:="NoXXX", After:=Range("AA6"),
LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)


If Not c Is Nothing Then
Do
Set rngArr(UBound(rngArr)) = c
ReDim Preserve rngArr(UBound(rngArr) + 1)
Set c = Cells.Find(What:="NoXXX", After:=Range(c.Address),
LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
Counter = Counter + 1
Loop Until c.Address = rngArr(0).Address Or Range("AA1") - 1 =
Counter
End If
ReDim Preserve rngArr(UBound(rngArr) - 1)
Set rng = rngArr(UBound(rngArr))
Debug.Print rng.Address
Done:
ActiveSheet.Columns("AA").Hidden = True
End Sub

Regards,
Per

 

[Patrick C. Simonds]

I seem to be at a lose to be able to get this to write data back to the
worksheet after the the TextBoxes have been edited.

Private Sub CommandButton1_Click()
Cells(rngArr(0).Row,(1, 7).Value = TextBox1.Value
Cells(rngArr(1).Row,(1, 7).Value = TextBox2.Value
Cells(rngArr(2).Row,(1, 7).Value = TextBox3.Value
End Sub

 

[Per Jessen]

Two things:

First you have to declare the RngArr() variable as public as below
(outside the module), and remove the related Dim statement:

Public rngArr() As Range

Second you have a syntax error in your macro, if values is to be
written back to column 7, then use this:

Private Sub CommandButton1_Click()
Cells(rngArr(0).Row, 7).Value = Me.TextBox1.Value
Cells(rngArr(1).Row, 7).Value = Me.TextBox2.Value
Cells(rngArr(2).Row, 7).Value = Me.TextBox3.Value
End Sub

Regards,
Per

 

[Patrick C. Simonds]

I thought about making rngArr() As Range public as well but when I do it I
get the following error:

Compile Error

Constants, fixed-length strings, arrays, user-defined types and Declare
Statements not allowed as Public members or object modules