VBA: Need pasted data to move to correct cells in a dynamic manner

[gravanoc]

Hello,

I am using a website called Quora & am trying to gather up some statistics on who I have posed questions to, since this data is not provided for us.

The process is as follows:

1) There is a list of questions in cells M3:M15 (I add more once they are depleted)
2) Next to the questions are the dates they were asked in N3:N15
3) In cell A1 I have a Boolean, either T or F. True will keep the process from progressing, and will overwrite further pastes. False will make it dynamic.
4) From Quora's website, I open one of my questions & then select a link to view the people I have asked questions. I can ask up to 25 people, so it ranges from 0 - 25. When I copy the information there, I receive a) Name, b) One sentence bio, c) Whether they have answered the question or not
5) I paste the information into cell C3, which triggers my VBA code. I will paste it below. I am sure there are better ways to do this, but I am not very good with VBA.

Links to pictures & workbook https://drive.google.com/open?id=1BGO4t0N3ywxeZ_GM7wH7Q7pavBxm6v5x



VBA Process

6) Event is triggered by Worksheet Change if target intersects with C3
7) Setup static variables for use in the dynamic portion of process
8) Some integers, range, long, & worksheet variables
9) Disable events
10) Boolean check for A1 as explained earlier, this affects the static variables
11) Feel free to look over the rest of the code. I provided several comments. The main problem has to do with the qRange variable & trying to keep it scaling correctly with the rest of the worksheet. Thank you for your assistance!

Option Explicit





Public Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Range("C3")) Is Nothing Then
        Static xP As Long
       ' xP is a convenience rather than doing lots of additional math
        Static qP As Long
       ' qP keeps track of which questions turn it is which is basically the iteration number of the process
        
       ' Static allows the variable to increment beyond the individual routine run
       
        Dim i As Integer
       ' i is used with the For counter below
        Dim x As Integer
       ' x is a secondary loop counter for convenience
        Dim iCount As Long
       ' Important variable that keeps track of how much is pasted
       
    
        Application.EnableEvents = False
    
    
    If Range("A1").Value = True Then
        
        xP = 0
        qP = 0
        iCount = Selection.Rows.Count
        
        ' Set this only if you need to realign the paste row
        
    Else
        
        qP = qP + 1
        iCount = Selection.Rows.Count
        xP = xP + (iCount / 3)
        
        ' This should be default
        
    End If
     
        Dim shtALG As Worksheet
        
        Dim sRange As Range
       'Source range generally
        Dim dRange As Range
       'Destination range generally
        Dim qRange As Range
       'Trying to keep concepts straight in my mind, just another convenience for Question range
        Dim xRange As Range
       'Counterpart to qRange
   
        x = 0
        i = 0
        
        Set shtALG = Worksheets("Harvest")
        Set xRange = shtALG.Range("G3").Offset(xP + i, 0)
               
        For i = 0 To (iCount / 3)
           'Everything in this For loop seems to work fine; once it hits 25 it goes to the label Sam
           'The formulas are used to clean up some useless junk in the bio section or to add No Desc if none exists
           
           If i >= 25 Then GoTo Sam
            Set shtALG = Worksheets("Harvest")
            
            Set dRange = shtALG.Range("D3").Offset((i + xP), 0)
            Set sRange = shtALG.Range("C3").Offset(x, 0)
            
            dRange.Value = sRange.Value
            
            Set dRange = shtALG.Range("E3").Offset((i + xP), 0)
            Set sRange = shtALG.Range("C4").Offset(x, 0)
            
            dRange.Value = sRange.Value
            
            Set dRange = shtALG.Range("F3").Offset((i + xP), 0)
            Set sRange = shtALG.Range("C5").Offset(x, 0)
            
            dRange.Value = sRange.Value
            
            x = x + 3
            
            Set sRange = shtALG.Range("k3").Offset((i + xP), 0)
            sRange.Select
            
            sRange.FormulaR1C1 = _
             "=IF(ISERR(FIND("","",RC[-6],1)),""No Description"",FIND("","",RC[-6],1))"
             
            Set sRange = shtALG.Range("k3").Offset((i + xP), 1)
            sRange.Select
             
            sRange.FormulaR1C1 = _
                  "=IF(RC[-1]=""No Description"",""No Description"",MID(RC[-7],RC[-1]+2,LEN(RC[-7])))"
                  
            Selection.Copy
            
            Set dRange = shtALG.Range("e3").Offset((i + xP), 0)
            dRange.Select
            
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                
Sam:
        
         Next
            
            Set sRange = shtALG.Range("d3").Offset((xP + (iCount / 3)), 0)
                       
            sRange.Select
            
            With Selection.Interior
             .Pattern = xlSolid
             .PatternColorIndex = xlAutomatic
             .Color = 65535
             .TintAndShade = 0
             .PatternTintAndShade = 0
            End With
            'With statement pretty useless, meant to keep track of where next iteration will go


            Set sRange = shtALG.Range("M3:N3").Offset(qP, 0)
            sRange.Select
            
            Selection.Copy


            xRange.Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            
            Set qRange = shtALG.Range(Cells(xP + 3, 7), Cells(((iCount + xP + xP + xP + 6) / 3), 8))
            'This works only under the right circumstances.  It is what I need HELP with primarily.
            qRange.Select
            Selection.FillDown
            
            Set dRange = shtALG.Range("k3:l27").Offset((xP), 0)
                       
            dRange.Select
    
            Application.CutCopyMode = False
            Selection.Clear
           
            Set dRange = shtALG.Range("c4:c79").Offset(0, 0)
            dRange.Select
            Selection.Clear
            
            'Just some general cleanup statements


           End If
            
     Application.EnableEvents = True


End Sub

 

[gravanoc]

I can clarify anything if needed!

 

[gravanoc]

Bump