Loop on VB

[gmazza76]

Good Afternoon,

I have created the VB below to check a name ( SiAName ) against the names Column c (3). If it finds the name i need it then to check a score ( Siquestion ) in SiScore column E ( 5 ) on sheet "Sheet 1"

Then all the information is placed on Sheet 2 from cell C36

Can anyone point me in the right direction as currently the VB just clicks with nothing happening and when i step through it keeps looping without any message

Sub Start_Of_SGSearch_Macro()
Dim SiAName As String
Dim SiFDate As String
Dim SiTDate As String
Dim Siquestion As String
Dim SiAdvocate As String
Dim SiDate As String
Dim SiAssessor As String
Dim SiScore As String
Dim SiPno As String
Dim SiPR As String
Dim SiPSR As String
Dim SiComments1T3 As String
Dim SiComments4T8 As String
Dim SiComments9T11 As String
Dim SiComments12T14 As String
Dim SiComments15T18 As String
Dim SiComments19T27 As String
Dim SiFutActions As String

Do
        SiAName = Sheets("Sheet 2").Cells(31, 4).Value
        SiFDate = Sheets("Sheet 2").Cells(28, 4).Value
        SiTDate = Sheets("Sheet 2").Cells(29, 4).Value
        Siquestion = Sheets("Sheet 2").Cells(33, 4).Value
        
'Info from this sheet
Application.ScreenUpdating = False
Sheets("sheet 1").Select
Range("B4").Select
        SiDate = ActiveCell.Offset(a, 2).Value 'Date
        SiAdvocate = ActiveCell.Offset(a, 3).Value 'Advocate
        SiAssessor = ActiveCell.Offset(a, 4).Value 'Assessor
        SiScore = ActiveCell.Offset(a, 5).Value 'Score
        SiPno = ActiveCell.Offset(a, 6).Value 'Process No.
        SiPR = ActiveCell.Offset(a, 8).Value 'Process Reason
        SiPSR = ActiveCell.Offset(a, 9).Value 'Process Sub Reason
        SiComments1T3 = ActiveCell.Offset(a, 13).Value 'Comments 1-3
        SiComments4T8 = ActiveCell.Offset(a, 19).Value 'Comments 4-8
        SiComments9T11 = ActiveCell.Offset(a, 23).Value 'Comments 9-11
        SiComments12T14 = ActiveCell.Offset(a, 27).Value 'Comments 12-14
        SiComments15T18 = ActiveCell.Offset(a, 32).Value 'Comments 15-18
        SiComments19T27 = ActiveCell.Offset(a, 42).Value 'Comments 19-27
        SiFutActions = ActiveCell.Offset(a, 44).Value 'Agreed Actions
    
 'Info placed on
 
If SiAName = SiAdvocate Then
    If SiScore = "Extra Mile" Then
        Sheets("Sheet 2").Select
        Range("C36").Select
        ActiveCell.Offset(b, 0).Value = SiDate
        ActiveCell.Offset(b, 1).Value = SiAdvocate
        ActiveCell.Offset(b, 2).Value = SiAssessor
        ActiveCell.Offset(b, 3).Value = SiScore
        ActiveCell.Offset(b, 4).Value = SiPno
        ActiveCell.Offset(b, 5).Value = SiPR
        ActiveCell.Offset(b, 6).Value = SiPSR
        ActiveCell.Offset(b, 7).Value = SiComments1T3
        ActiveCell.Offset(b, 8).Value = SiComments4T8
        ActiveCell.Offset(b, 9).Value = SiComments9T11
        ActiveCell.Offset(b, 10).Value = SiComments12T14
        ActiveCell.Offset(b, 11).Value = SiComments15T18
        ActiveCell.Offset(b, 12).Value = SiComments19T27
        ActiveCell.Offset(b, 13).Value = SiFutActions
        
    Else
        MsgBox "Uanble to Find any Quality " & SiAdvocate & ". Please try Another Score .", vbOKOnly, "Score Not Found For Advocate"
    End If
End If
    b = b + 1
            
    a = a + 1

Loop Until SiAdvocate = ""
Application.ScreenUpdating = False
With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
    End With
Sheets("SGrimshaw Manager").Select
End Sub

 

[bertie]

From your code and explation I have assumed there could be multiple instances of SiAName in sheet1, each of which has to be transferred onto sheet 2.

Rather than set up a load of variables I would use a range variable, rng, to loop through column B on sheet1.
And a worksheet variable, ws2, for sheet2.

  [COLOR=darkblue]Set[/COLOR] rng = Sheets("Sheet1").Range("B4")
  [COLOR=darkblue]Set[/COLOR] ws2 = Sheets("Sheet2")

I have also used a rowCounter to increment the output row on sheet2.

The code loops through column B until it finds an empty cell.
It performs the checks
And transfers the data

  [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] rng = ""
    [COLOR=darkblue]If[/COLOR] rng.Offset(0, 3).Value = SiAName [COLOR=darkblue]Then[/COLOR]              [COLOR=green]'col E value[/COLOR]
      [COLOR=darkblue]If[/COLOR] rng.Offset(0, 5).Value = "Extra Mile" [COLOR=darkblue]Then[/COLOR]       'col G value
        [COLOR=green]'transfer the data[/COLOR]
        [COLOR=darkblue]With[/COLOR] ws2
          .Cells(rowCounter, 2).Value = rng.Offset(0, -1) [COLOR=green]'col A value[/COLOR]
          .Cells(rowCounter, 3).Value = rng.Value         'col B value
          .Cells(rowCounter, 4).Value = rng.Offset(0, 1)  [COLOR=green]'col C value[/COLOR]
          '
          [COLOR=green]'yah de da de da[/COLOR]
          [COLOR=green]'[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]

My full sample code is shown below. It will need editing for sheet names, cell references, and any other variables you need.

[COLOR=darkblue]Sub[/COLOR] Start_Of_SGSearch_Macro02()
  [COLOR=darkblue]Dim[/COLOR] rng [COLOR=darkblue]As[/COLOR] Range      [COLOR=green]'Sheet1 range to loop through[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] ws2 [COLOR=darkblue]As[/COLOR] Worksheet  [COLOR=green]'Sheet2[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] SiAName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] rowCounter [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]  [COLOR=green]'sheet2 row counter[/COLOR]
 
  [COLOR=green]'initialize variables[/COLOR]
  [COLOR=darkblue]Set[/COLOR] rng = Sheets("Sheet1").Range("B4")
  [COLOR=darkblue]Set[/COLOR] ws2 = Sheets("Sheet2")
  SiAName = Sheets("Sheet2").Cells(31, 4).Value
  rowCounter = 36   [COLOR=green]'sheet2 row counter[/COLOR]
 
  [COLOR=green]'reset application setting on error[/COLOR]
  [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] errHandler
  Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
 
  [COLOR=green]'loop through sheet1[/COLOR]
  [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] rng = ""
    [COLOR=darkblue]If[/COLOR] rng.Offset(0, 3).Value = SiAName [COLOR=darkblue]Then[/COLOR]              [COLOR=green]'col E value[/COLOR]
      [COLOR=darkblue]If[/COLOR] rng.Offset(0, 5).Value = "Extra Mile" [COLOR=darkblue]Then[/COLOR]       'col G value
        [COLOR=green]'transfer the data[/COLOR]
        [COLOR=darkblue]With[/COLOR] ws2
          .Cells(rowCounter, 2).Value = rng.Offset(0, -1) [COLOR=green]'col A value[/COLOR]
          .Cells(rowCounter, 3).Value = rng.Value         'col B value
          .Cells(rowCounter, 4).Value = rng.Offset(0, 1)  [COLOR=green]'col C value[/COLOR]
          '
          [COLOR=green]'yah de da de da[/COLOR]
          [COLOR=green]'[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        [COLOR=green]'increment row counter[/COLOR]
        rowCounter = rowCounter + 1
      [COLOR=darkblue]Else[/COLOR]
        MsgBox "not found message goes here"
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
    [COLOR=green]'next row[/COLOR]
    [COLOR=darkblue]Set[/COLOR] rng = rng.Offset(1, 0)
  [COLOR=darkblue]Loop[/COLOR]
 
errHandler:
  Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

If there is only one instance of SiAName on sheet1 you can replace the Do...Loop with a Find routine.
i.e.,
Set Rng = Find....
You can get the necessary code for this from the macro recorder.

 

[gmazza76]

cheers