find "w" instance in column and count within range then change the next "Daily" val.

[rrosa1]

how can i do with this code i know hear good Samaritan help me in past thanks a lot's to look into it

Sub put_w()
    Dim ws As Worksheet
    Dim i As Long
    Dim rTFind As Range, rBFind, rFirst

    Set ws = ThisWorkbook.Worksheets("pp")
    rTitle = ws.Cells.find("Balance", ws.[A1], xlValues, xlPart).Row
    'Spot bottom row of data
    LR = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
    '# Start search
    ' # Search for the "period" in column A to spot the top of the data range

    Set rTFind = ws.Range("A:A").find(".", ws.[A1], xlValues, xlWhole)
    If Not rTFind Is Nothing Then
        Set rFirst = rTFind
        Do
            Set rBFind = ws.Range("A:A").FindNext(rTFind)
            'sname = Format(Day(Int(rTFind.Offset(-1))) + 1, "DD")

            'ws.Rows(rTitle).Copy Sheets(sname).Cells(rTitle, "A")
            If rBFind.Address <> rFirst.Address Then
                With ws
                    'then count the occurence in that row range which have  "w"
                     '' how i can incorporate this function to count in my code ?
                    Var = count("w", Range(rTFind.Address, rBFind.Address))
                  'if it is less then 6 time then change the value in column L to make
                    If Var <= 6 Then
                        For i1 = .Cells(.Rows.count, 1).End(xlUp).Row To 5 Step -1
                            If .Cells(i1, 12).Value = "w" Then
                               If MsgBox("u want to change value of L?" & Var, vbYesNo, "Order Complete") = vbNo Then
                                    Exit Sub

                        'by asking though input box like this one below
                       'Application.InputBox("change column B name data range", Type:=8)
                       'the total count 6 and also change the value in column C,D,E value


                                End If
                            End If
                        Next i1
                    End If
                End With
            Else
                'do same on last records

            End If

            If rBFind.Address = rFirst.Address Then Exit Do
            Set rTFind = rBFind
        Loop
        ' Stop
    End If
    Set rTFind = Nothing
    Set rBFind = Nothing
    Set rFirst = Nothing

End Sub

'Var = count("w", Range("A1:A100"))

Function count(find As String, lookin As Range) As Long
    Dim cell As Range
    For Each cell In lookin
        If (cell.Value = find) Then count = count + 1    '//case sens
    Next
End Function

hear is my sample data wb

[p45cal]

try this instead of your Sub put_w():

Sub put_w2()
Dim ws As Worksheet
Dim i As Long
Dim rTFind As Range, rBFind, rFirst, mylookin As Range

Set ws = ThisWorkbook.Worksheets("pp")
rTitle = ws.Cells.find("Balance", ws.[A1], xlValues, xlPart).Row
'Spot bottom row of data
LR = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
'# Start search
' # Search for the "period" in column A to spot the top of the data range

Set rTFind = ws.Range("A:A").find(".", ws.[A1], xlValues, xlWhole)
If Not rTFind Is Nothing Then
  Set rFirst = rTFind
  Do
    'sname = Format(Day(Int(rTFind.Offset(-1))) + 1, "DD")

    'ws.Rows(rTitle).Copy Sheets(sname).Cells(rTitle, "A")
    With ws
      'then count the occurence in that row range which have  "w"
      '' how i can incorporate this function to count in my code ?
      Set mylookin = rTFind.CurrentRegion.Columns(12)
      Set mylookin = mylookin.Offset(1).Resize(mylookin.Rows.count - 1)
      Var = count("w", mylookin)
      'if it is less then 6 time then change the value in column L to make
      If Var < 6 Then
        For i1 = mylookin.Rows.count To 1 Step -1
          'mylookin.Cells(i1).Select  'pd
          If Var < 6 And mylookin.Cells(i1).Value <> "w" Then
            mylookin.Cells(i1).Select  'pd
            myResponse = MsgBox("u want to change value of L" & Selection.Row & "?" & vbLf & "Cancel moves on to the next group", vbYesNoCancel, "Order Complete")
            Select Case myResponse
              Case vbCancel
                Exit For
              Case vbYes
                mylookin.Cells(i1).Value = "w"
                Var = Var + 1
            End Select
          End If
        Next i1
      End If
    End With

    Set rTFind = ws.Range("A:A").FindNext(rTFind)
    If rTFind.Address = rFirst.Address Then Exit Do
  Loop
  ' Stop
End If
Set rTFind = Nothing
Set rBFind = Nothing
Set rFirst = Nothing
End Sub

Also this needs a tweak to avoid confusion:

Function count(find As String, lookin As Range) As Long
    Dim cll As Range
    For Each cll In lookin.Cells
        If (cll.Value = find) Then count = count + 1    '//case sens
    Next
End Function

[rrosa1]

hi p45cal
thanks a lot's u save my day but when i try to run the code it give me error 1004 "select method or range class fail at this line

 mylookin.Cells(i1).Select 'pd

thanks agin for your help

[p45cal]

Early on in your code you have a reference to ThisWorkbook.Worksheets("pp"), this has to be the active sheet at the time the code runs. If you are experimenting on another sheet you have either:
To change ThisWorkbook.Worksheets("pp") to reflect the active sheet's name
or
change ThisWorkbook.Worksheets("pp") to ActiveSheet

[rrosa1]

thanks p45cal
is there anyway code only change to"pp" sheet ? aslo one more change to remove the msg box and do change the value
since there will b lot's of "w" to b changed

[rrosa1]

thanks p45cal

Set ws = ThisWorkbook.Worksheets("pp")

i change this to

    Set ws = ThisWorkbook.Worksheets("pp")
    ws.Activate

and also i comment the msg as this

                        If Var < 6 And mylookin.Cells(i1).Value <> "w" Then
                            mylookin.Cells(i1).Select    'pd
                            ' myResponse = MsgBox("u want to change value of L" & Selection.Row & "?" & vbLf & "Cancel moves on to the next group", vbYesNoCancel, "Order Complete")
                            ' Select Case myResponse
                            ' Case vbCancel
                            '     Exit For
                            ' Case vbYes
                            mylookin.Cells(i1).Value = "w"
                            
                            Var = Var + 1
                            ' End Select
                        End If

and it's work like a charm thanks again for all yr help i still learning so sorry for dumb question. and thanks for bear up with me .

[p45cal]

If you want it only to work on sheet pp and you don't need the msgbox question, then you don't need to select the cell (it was only to show the user which cell might be changed), then you also don't need to activate the sheet, so you can also lose the lines:
mylookin.Cells(i1).Select 'pd
and
ws.Activate

There are 4 other lines which are redundant and can be removed:
rTitle = ws.Cells.find("Balance", ws.[A1], xlValues, xlPart).Row
LR = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
With ws
End With

[rrosa1]

thanks p45cal
i did remove those line and code still work as intended.
thanks

[rrosa1]

hi p45cal
sorry to bother u again ,i was trying to change this line of code

            If Var < 6 Then
                
                For iw = mylookin.Rows.count To 1 Step -1
                    'mylookin.Cells(iw).Select
                    If Var < 6 And mylookin.Cells(iw).Value <> "Weekly" Then    '''to make 6 count weekly

to this

            If Var < 6 Then
                'If Var  Then
                For iw = mylookin.Rows.count To 1 Step -1
                    'mylookin.Cells(iw).Select
                    If Var < 5 And mylookin.Cells(iw).Value <> "Weekly" Then    '''to make 6 count weekly

but then code did not change the data sheet as needed when i run the macro again can u let me know what mi doing wrong
by the way my intention is to change the limit from 6 to 5 or 4 since there r some time data change so i need to change that value but it must be less then 6 how can i do that?
yr help is appreciated.

[p45cal]

You'd better supply all the code as is.

[rrosa1]

sorry hear my change from yr original code

Sub aa_put_w()
    Dim ws1 As Worksheet
    Dim iw As Long, LR, Var
    Dim rTFind As Range, rBFind, rFirst, mylookin As Range
    Dim a As String, nm
    Dim cc As Double

    Set ws1 = ThisWorkbook.Worksheets("RR")
    ws1.Activate
    ' rTitle = ws.Cells.find("Balance", ws.[A1], xlValues, xlPart).Row
    'Spot bottom row of data
    ' LR = ws1.Cells(ws1.Rows.count, "A").End(xlUp).Row
    '# Start search
    ' # Search for the "period" in column A to spot the top of the data range


    On Error Resume Next
    nm = Application.InputBox("Name to be inserted in C ?", Title:="Name Input", Default:="P B", Type:=2)    'type 2 is text
    If nm = "" Then GoTo ExitHandler
    'On Error Resume Next
    cc = Application.InputBox("Name to be inserted in C ?", Default:=41.29, Type:=1)    'type 1 is num
    If cc = 0 Then GoTo ExitHandler

    Set rTFind = ws1.Range("A:A").find(".", ws1.[A1], xlValues, xlWhole)
    If Not rTFind Is Nothing Then
        Set rFirst = rTFind
        Do
            'With ws1
            'then count the occurence in that row range which have  "w"
            Set mylookin = rTFind.CurrentRegion.Columns(12)
            Set mylookin = mylookin.Offset(1).Resize(mylookin.Rows.count - 1)
            Var = count("Weekly", mylookin)
            'if it is less then 6 time then change the value in column L to makeup for 6 time
            mylookin.Cells(iw, 2).Value = Var
            If Var < 6 Then
                
                For iw = mylookin.Rows.count To 1 Step -1
                    'mylookin.Cells(iw).Select
                    If Var < 5 And mylookin.Cells(iw).Value <> "Weekly" Then    '''to make 6 count weekly
                        mylookin.Cells(iw, 3).Value = Var    'Selection.Row 'mylookin.Cells(i1).Value '.Select    'pd
                        ' myResponse = MsgBox("u want to change value of L" & Selection.Row & "?" & vbLf & "Cancel moves on to the next group", vbYesNoCancel, "Order Complete")
                        ' Select Case myResponse
                        ' Case vbCancel
                        '     Exit For
                        ' Case vbYes
                        mylookin.Cells(iw).Value = "Weekly"
                        mylookin.Cells(iw, -8).Value = nm
                        mylookin.Cells(iw, -6).Value = cc
                        mylookin.Cells(iw, -5).Value = cc
                        Var = Var + 1
                        ' End Select
                    End If
                Next iw
            End If
            'End With

            Set rTFind = ws1.Range("A:A").FindNext(rTFind)
            If rTFind.Address = rFirst.Address Then Exit Do
        Loop
        ' Stop
    End If
ExitHandler:
    Set Var = Nothing
    Set rTFind = Nothing
    Set rBFind = Nothing
    Set rFirst = Nothing

End Sub
'''' for weekly counts
Function count(find As String, lookin As Range) As Long
    Dim cll As Range
    For Each cll In lookin.Cells
        If (cll.Value = find) Then count = count + 1    '//case sens
    Next
End Function

when i try to run macro again for < 6 it count all weekly in column L i try to print on sh in "M3" i also added the new work book where code not work

[p45cal]

by the way my intention is to change the limit from 6 to 5 or 4 since there r some time data change so i need to change that value but it must be less then 6 how can i do that?

Is the change to 4, 5 or 6 for the whole sheet or per group on the sheet? Do you want to ask the user what the limit is each time?

but then code did not change the data sheet as needed when i run the macro again can u let me know what mi doing wrong

Well that's a difficult one because I have no idea what 'as needed' is.

I see you put the count in column M before you make changes; do you want this to be after you make changes instead?
Does M3 value represent the total count of 'Weekly' on the whole sheet? If so, before or after changes made?

It would be a good idea to change all instances of If Var < 6 so that they are all the same.

[rrosa1]

hi p45cal
is it possible to do this ,when 1time run the code then
if within finding "." row "per group" if Weekly is 3 time then change to 4 go to next group of row if weekly is 4 time then make it to 5 time and if it is 5 then make it 6 time and if it is 6 then do nothing .hope i explained it right.

I see you put the count in column M before you make changes; do you want this to be after you make changes instead?

that i was looking for how many "Var" found in each group and how many change have be made .that data is not needed one it work with sample data

Is the change to 4, 5 or 6 for the whole sheet or per group on the sheet? Do you want to ask the user what the limit is each time?

it's per group and if it ask the limit each time is batter too so i don't need to change the code each time if limit chage

[p45cal]

try:

Sub aa_put_w()
Dim ws1 As Worksheet
Dim iw As Long, LR, Var
Dim rTFind As Range, rBFind, rFirst, mylookin As Range
Dim a As String, nm
Dim cc As Double

Set ws1 = ThisWorkbook.Worksheets("RR")
ws1.Activate
'On Error Resume Next
nm = Application.InputBox("Name to be inserted in C ?", Title:="Name Input", Default:="P B", Type:=2)  'type 2 is text
If nm = "" Then GoTo ExitHandler
'On Error Resume Next
cc = Application.InputBox("Name to be inserted in C ?", Default:=41.29, Type:=1)  'type 1 is num
If cc = 0 Then GoTo ExitHandler

Set rTFind = ws1.Range("A:A").find(".", ws1.[A1], xlValues, xlWhole)
If Not rTFind Is Nothing Then
  Set rFirst = rTFind
  Do
    Set mylookin = rTFind.CurrentRegion.Columns(12)
    Set mylookin = mylookin.Offset(1).Resize(mylookin.Rows.count - 1)
    Var = count("Weekly", mylookin)
    mylookin.Cells(0, 2).Value = Var
    If Var < 6 Then ' if 6 or more do nothing.
    TargetCount = Var + 1 ' this line sets the target number of Weekly in the group to one more than that found (if there were less than 6).
      For iw = mylookin.Rows.count To 1 Step -1
        'mylookin.Cells(iw).Select
        If Var < TargetCount And mylookin.Cells(iw).Value <> "Weekly" Then  '''to make 6 count weekly
          mylookin.Cells(iw, 3).Value = Var  'Selection.Row 'mylookin.Cells(i1).Value '.Select    'pd
          mylookin.Cells(iw).Value = "Weekly"
          mylookin.Cells(iw, -8).Value = nm
          mylookin.Cells(iw, -6).Value = cc
          mylookin.Cells(iw, -5).Value = cc
          Var = Var + 1
        End If
      Next iw
    End If
    Set rTFind = ws1.Range("A:A").FindNext(rTFind)
    If rTFind.Address = rFirst.Address Then Exit Do
  Loop
  ' Stop
End If
ExitHandler:
Set Var = Nothing
Set rTFind = Nothing
Set rBFind = Nothing
Set rFirst = Nothing

End Sub

[rrosa1]

sorry to b pain in back but code does not do change the value in L as well as other column it only print total Var found in "M5"
and i try to step in to the code by F8 and c where it goes it counting all the weekly in l in function .

[p45cal]

temporarily add the line:
mylookin.Cells(iw).Interior.Color = vbRed
directly after the line:
mylookin.Cells(iw).Value = "Weekly"
to highlight the changed cells in column L.

It works here, but then I don't have your sheet RR.

[rrosa1]

i did but the same result as nothing change,i try to step in to the code by "F8" macro do not inter in to

            If Var < 6 Then    ' if 6 or more do nothing.
                TargetCount = Var + 1    ' this line sets the target number of Weekly in the group to one more than that found (if there were less than 6).
                For iw = mylookin.Rows.count To 1 Step -1
                    'mylookin.Cells(iw).Select
                    If Var < TargetCount And mylookin.Cells(iw).Value <> "Weekly" Then    '''to make 6 count weekly
                        mylookin.Cells(iw, 3).Value = Var    'Selection.Row 'mylookin.Cells(i1).Value '.Select    'pd
                        mylookin.Cells(iw).Value = "Weekly"
                        mylookin.Cells(iw).Interior.Color = vbRed
                        mylookin.Cells(iw, -8).Value = nm
                        mylookin.Cells(iw, -6).Value = cc
                        mylookin.Cells(iw, -5).Value = cc
                        Var = Var + 1
                    End If
                Next iw
            End If

so it did not change the color i think it do not getting the range value for group
from hear

            Set mylookin = rTFind.CurrentRegion.Columns(12)
            Set mylookin = mylookin.Offset(1).Resize(mylookin.Rows.count - 1)
            Var = count("Weekly", mylookin)

so it just counting all weekly from column L since it is > 6 so it do not go in to IF statment
what v can change for mylookin to find range between two "." ?

btw there is 1 more rr(2) sh in wb it same data sh u can use that to
but u need to change the name

[p45cal]

Send me the file

[rrosa1]

Send me the file

[p45cal]

Well, you've made some changes, you've added some data in the blank rows between groups, namely in cells C15, C32, C44, C54, C64, C74, C86, C96, C106, C117, C126, C134, C144, C155, C164, C180, C192 and C201.
The code depended on .CurrentRegion of each group and this worked because each group was separated from the next by a completely blank row. This no longer exists. The .currentRegion is now the whole data on the sheet. Delete those values to blank cells.

Next, you have the line:
If Var < TargetCount And mylookin.Cells(iw).Value <> "w" Then
which is looking for "w", not "Weekly".

There are one or two other changes.

See attached which has two buttons, one to recreate a sheet rr to work on; it copies rr(2) then deletes the 1s in column C. Then there is another button which runs the macro.