CODEWITHSUNDEEP
excelvba
N R
N R

Reputation: 11

Values not capture properly

I have a question related to the VBA.

I have a code to do simple task but i don't what's the reason but sometimes this code works perfectly some time it's not.

Go to active sheets(un-hidden) sheets in the work book.

Search specific text in the assign column, in this case text is "Sum of Current Activity".

Copy the cell before the text.

Go to Reviewer sheet and find sheet name in the table.

Paste the copied cell as link value next to cell where we have sheet name in the table.

Continue the same process until all active sheets searched

CODE

Sub Sum of_Current_activity() 
Dim sht As Worksheet
Sheets("Reviewer Sheet").Select

For Each sht In ActiveWorkbook.Worksheets
If sht.Name <> "Reviewer Sheet" And Left(sht.Name, 1) = 0 Then

On Error Resume Next 
sht.Select

f2 = " Total"
£1 = ActiveSheet.Name & f2

Sheets(sht).Select
Columns("J:J").Select
Selection.Find(What:="Sum of Current Activity", _
After:=ActiveCell,_
LookIn:=xlValues,_
LookAt:=xlPart,_
SearchOrder:=xlByRows,_
SearchDirection:=x1Next,_
MatchCase:=False).Activate

ActiveCell.Offset(0, 1).Select
Selection.Copy

Sheets("Reviewer Sheet").Select 
Columns("C:C").Select
Selection.Find(What:=f1, _
After:=ActiveCell,_
LookIn:=xlValues,_
LookAt:=xlPart,_
SearchOrder:=xlByRows,_
SearchDirection:=xlNext,_
MatchCase:=False).Activate

ActiveCell.Offset(0, 14).Select 
ActiveSheet. Paste Link:=True

Else
End If 

Next sht

  End Sub

P.S, I have 10 different specific text to search in the 25 sheet. this code sometime works for all 10 texts and sometimes miss the values.

Upvotes: 0

Views: 83

Answers (2)

Tim Williams
Tim Williams

Reputation: 166755

Untested but something like this should work:

Sub Sum of_Current_activity() 
Dim sht As Worksheet, c1 As Range, c2 As range


For Each sht In ActiveWorkbook.Worksheets
    If sht.Name Like "0*" Then

        Set c1 = sht.Columns("J:J").Find(What:="Sum of Current Activity", _
                     LookIn:=xlValues,  LookAt:=xlPart, MatchCase:=False)

        Set c2 = Sheets("Reviewer Sheet").Columns("C:C").Find( _
                 What:= sht.Name & " Total", _
                 LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) 

        If not c1 is nothing and not c2 is nothing then
            'edit: create link instead of copy value
            c2.offset(0, 14).Formula = _
              "='" & c1.parent.Name & "'!" & c1.offset(0,1).Address(true, true)

        End if


    End If    
Next sht

End Sub

Upvotes: 1

DisplayName
DisplayName

Reputation: 13386

just because the task is simple, you could use On Error Resume Next statement and make a direct Value paste between ranges:

Sub main()
    Dim sht As Worksheet

    On Error Resume Next ' prevent any subsequent 'Find()' method failure fro stopping the code
    For Each sht In Worksheets
        If Left(sht.Name, 1) = "0" Then _
            Sheets("Reviewer Sheet").Columns("C:C").Find( _
                     What:=sht.Name & " Total", _
                     LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False).Offset(0, 14).Value = sht.Columns("J:J").Find(What:="Sum of Current Activity", _
                         LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False).Offset(0, 1).Value
    Next
End Sub

I once more stress that On Error Resume Next is here used only because it's a case where you can have a full control of its side effects that can arise from ignoring errors and go on

should you use this snippet in a bigger code, than close the snippet with On Error GoTo 0 statement and resume default error handling before going on with some other code.

Upvotes: 0

Related Questions