Loop Issue

[gmazza76]

Good Morning,

I have written some code to pull information into another sheet but it doesnt loop correctly it just over writes the first line.

can anyine help and point me in the right direction how to correct this

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
Dim FoundMe As Boolean
FoundMe = False
a = 4
    Do
        SiAName = Sheets("SGrimshaw Manager").Cells(31, 4).Value
        SiFDate = Sheets("SGrimshaw Manager").Cells(28, 4).Value
        SiTDate = Sheets("SGrimshaw Manager").Cells(29, 4).Value
        Siquestion = Sheets("SGrimshaw Manager").Cells(33, 4).Value
        
'Info from this sheet
        Application.ScreenUpdating = False
        Sheets("Simone Grimshaw").Select
        Range("C4").Select
        SiDate = Cells(a, 2) 'Date
        SiAdvocate = Cells(a, 3) 'Advocate
        SiAssessor = Cells(a, 4) 'Assessor
        SiScore = Cells(a, 5) 'Score
        SiPno = Cells(a, 6) 'Process No.
        SiPR = Cells(a, 8) 'Process Reason
        SiPSR = Cells(a, 9) 'Process Sub Reason
        SiComments1T3 = Cells(a, 13) 'Comments 1-3
        SiComments4T8 = Cells(a, 19) 'Comments 4-8
        SiComments9T11 = Cells(a, 23) 'Comments 9-11
        SiComments12T14 = Cells(a, 27) 'Comments 12-14
        SiComments15T18 = Cells(a, 32) 'Comments 15-18
        SiComments19T27 = Cells(a, 42) 'Comments 19-27
        SiFutActions = Cells(a, 44) 'Agreed Actions
    
 'Info placed on
 
        If SiAName = SiAdvocate Then
            If SiScore = Siquestion Then
                FoundMe = True
                Sheets("SGrimshaw Manager").Select
                MyEntryRow = Find_Functions.Get_Row("Date", 2) + 1
                Cells(MyEntryRow, 2) = SiDate
                Cells(MyEntryRow, 3) = SiAdvocate
                Cells(MyEntryRow, 5) = SiAssessor
                Cells(MyEntryRow, 8) = SiScore
                Cells(MyEntryRow, 12) = SiPno
                Cells(MyEntryRow, 15) = SiPR
                Cells(MyEntryRow, 18) = SiPSR
                Cells(MyEntryRow, 23) = SiComments1T3
                Cells(MyEntryRow, 28) = SiComments4T8
                Cells(MyEntryRow, 29) = SiComments9T11
                Cells(MyEntryRow, 30) = SiComments12T14
                Cells(MyEntryRow, 31) = SiComments15T18
                Cells(MyEntryRow, 32) = SiComments19T27
                Cells(MyEntryRow, 33) = SiFutActions
            End If
        End If
        b = b + 1
        a = a + 1
    Loop Until SiAdvocate = ""
  
    If FoundMe = False Then
        MsgBox "Unable to Find any Quality " & SiAdvocate & ". Please try Another Score .", vbOKOnly, "Score Not Found For Advocate"
    End If
    
    Application.ScreenUpdating = False
    
    With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
    End With

 

[Andrew Poulsom]

What does this do?

Find_Functions.Get_Row("Date", 2)

 

[gmazza76]

Morning,

This relates to the following code:

Function Get_Row(MyString As String, MyColumn As Long)
Dim MyFind As Object
    Set MyFind = Columns(MyColumn).Find(what:=MyString, searchdirection:=xlNext, lookat:=xlWhole)
    If MyFind Is Nothing Then
        Get_Row = 0
    Else
        Get_Row = MyFind.Row
    End If
    
    Set MyFind = Nothing
End Function

The Find_Functions is the name of the Module and Get_Row is the name of the function. In order for the function to work you need to pass parameters to it, which are indicated when you type Find_Functions.Get_Row

Hope this helps or do you know an easier way to do this?

Many Thanks

 

[Andrew Poulsom]

So is it finding "Date" in column 2? Or is it returning zero? You can find out like this:

MyEntryRow = Find_Functions.Get_Row("Date", 2) + 1
MsgBox MyEntryRow
Cells(MyEntryRow, 2) = SiDate

 

[gmazza76]

what it should be doing is matching SiAName ( agent ) in column 3, then matching the score selected in SiScore to Siquestion ( column 5 ). If this is correct it will then populate the data on SGrimshaw Manager sheet.

I will need to write into the code concerning the dates which will be held in column 2 as i need this to be added as another criteria

Cheers
Gavin

 

[Andrew Poulsom]

I dare say that's what it should be doing, but is it? What die the message box return?

 

[gmazza76]

The error message comes up saying it cannot be found

 

[Andrew Poulsom]

What cannot be found? The message box should return 1 or some higher number. If it returns 1 the Get_Row function is returning zero because the word Date can't be found in column 2.

 

[gmazza76]

Afternoon,

I have kind of fixed the loop issue bar 2 things
1. I have tried to insert an query where i restrict the info to dates
This seems to cause Loop errors that i cant figure out ( line in RED )
2. When it drags the info in it leaves a line in between each that is pulled in.

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
Dim FoundMe As Boolean
Dim MyCounter As Integer
Dim Startdate As Variant
Dim Stopdate As Variant

FoundMe = False
a = 4
MyCounter = 0
    Do
        SiAName = Sheets("SGrimshaw Manager").Cells(31, 4).Value
        SiFDate = Sheets("SGrimshaw Manager").Cells(4, 7).Value
        SiTDate = Sheets("SGrimshaw Manager").Cells(4, 10).Value
        Siquestion = Sheets("SGrimshaw Manager").Cells(33, 4).Value
        
'Info from this sheet
        Application.ScreenUpdating = False
        Sheets("Simone Grimshaw").Select
        Range("C4").Select
        SiDate = Cells(a, 2) 'Date
        SiAdvocate = Cells(a, 3) 'Advocate
        SiAssessor = Cells(a, 4) 'Assessor
        SiScore = Cells(a, 5) 'Score
        SiPno = Cells(a, 6) 'Process No.
        SiPR = Cells(a, 8) 'Process Reason
        SiPSR = Cells(a, 9) 'Process Sub Reason
        SiComments1T3 = Cells(a, 13) 'Comments 1-3
        SiComments4T8 = Cells(a, 19) 'Comments 4-8
        SiComments9T11 = Cells(a, 23) 'Comments 9-11
        SiComments12T14 = Cells(a, 27) 'Comments 12-14
        SiComments15T18 = Cells(a, 32) 'Comments 15-18
        SiComments19T27 = Cells(a, 42) 'Comments 19-27
        SiFutActions = Cells(a, 44) 'Agreed Actions
    
 'Info placed on
        
        If SiAName = SiAdvocate Then
            If SiScore = Siquestion Then
            'If SiDate >= Startdate And SiTDate <= Stopdate Then
                FoundMe = True
                Sheets("SGrimshaw Manager").Select
                MyEntryRow = Find_Functions.Get_Row("Date", 2)
                For j = MyEntryRow To 650000
                    If Cells(j, 2) = "" Then Exit For
                    If Cells(j, 2) <> "" Then
                        MyCounter = MyCounter + 1
                    End If
                Next j
                If MyCounter = 0 Then
                       MyCounter = 1
                End If
                MyEntryRow = MyEntryRow + MyCounter
                Cells(MyEntryRow, 2) = SiDate
                Cells(MyEntryRow, 3) = SiAdvocate
                Cells(MyEntryRow, 5) = SiAssessor
                Cells(MyEntryRow, 8) = SiScore
                Cells(MyEntryRow, 12) = SiPno
                Cells(MyEntryRow, 15) = SiPR
                Cells(MyEntryRow, 18) = SiPSR
                Cells(MyEntryRow, 23) = SiComments1T3
                Cells(MyEntryRow, 28) = SiComments4T8
                Cells(MyEntryRow, 29) = SiComments9T11
                Cells(MyEntryRow, 30) = SiComments12T14
                Cells(MyEntryRow, 31) = SiComments15T18
                Cells(MyEntryRow, 32) = SiComments19T27
                Cells(MyEntryRow, 33) = SiFutActions
            End If
        End If
        b = b + 1
        a = a + 1
    Loop Until SiAdvocate = ""
    
    
    If FoundMe = False Then
        MsgBox "Unable to Find any Quality " & SiAdvocate & ". Please try Another Score .", vbOKOnly, "Score Not Found For Advocate"
    End If
    
    Application.ScreenUpdating = False
    
    With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
    End With
    
    Sheets("SGrimshaw Manager").Select
End Sub

 

[Andrew Poulsom]

Why are your dates declared as String? Try declaring them as Date.