Search code examples
vbaexcelloopsoffset

VBA offset within loop


I'm having issues combining the VBA offset function within a loop. Essentially I am trying to extract multiple sets of values from a column of data based on a search term (survey value). I can get this to work for a single term, but I was hoping to create a macro that would extract all the values for all terms at once.

The set up of the data is a column (c6:c50) of raw data (indicators), and then 13 columns (j6:j50, m6:m50 etc) (output) where the extracted values should appear. columns K and L (and so on between the initial 13 columns) contain formulas based on the values of column J. the search term for each of the 13 columns is in the cell directly above the range (J5, M5 etc.).

The code below is where I have got to. The aim was to have a loop that extracts the values from column C into column J (the 'i'-based loop) and then a second loop ('j'-based loop) that offsets across the columns.

What happens when this is run is that the firstcell value in cell J6 fills, followed by the correct value in J7. Then all subsequent extracted values overwrite what was in J7. Once the loop for the first term is complete, it offsets by 3 columns, extracts the same value in J6 to M6 (presumably because the search term 'survey' is not offsetting?) but then goes back to overwriting cell J7.

Any help would be greatly appreciated.

Sub indicator_charts()

Dim indicators As Range
Dim survey As String
Dim surveyrng As Range
Dim output As Range
Dim survey2 As String
Dim firstcell As Range

Set indicators = Worksheets("Indicator Summary").Range("C6:C50")
Set output = Worksheets("Indicator Summary").Range("j5:j50")
Set surveyrng = Worksheets("Indicator Summary").Range("J5")
Set firstcell = Worksheets("Indicator Summary").Range("J6")

survey = surveyrng.Value

For j = 0 To 36 Step 3
output.Offset(0, j) = output
surveyrng.Offset(0, j) = surveyrng
firstcell.Offset(0, j) = firstcell
    For i = 1 To 46
        If InStr(1, indicators.Cells(i, 1).Value, survey) Then
        survey2 = indicators.Cells(i, 1).Value
            If IsEmpty(firstcell) Then
            firstcell.Value = survey2
            Else
            output.End(xlDown).Offset(1, 0).Value = survey2
            End If
        End If
    Next i
Next j

End Sub

Solution

  • I modified your code a bit. Should do what you want now.

    Sub indicator_charts()
    
    Dim indicators As Range
    Dim survey As String
    Dim surveyrng As Range
    Dim output As Range
    Dim survey2 As String
    Dim firstcell As Range
    Dim OutputVar As Variant
    Dim SurveyRngVar As Variant
    Dim FirstCellVar As Variant
    
    Set indicators = Worksheets("Indicator Summary").Range("C6:C50")
    Set output = Worksheets("Indicator Summary").Range("j5:j50")
    Set surveyrng = Worksheets("Indicator Summary").Range("J5")
    Set firstcell = Worksheets("Indicator Summary").Range("J6")
    
    For j = 0 To 36 Step 3
    Set OutputVar = output.Offset(0, j)
    Set SurveyRngVar = surveyrng.Offset(0, j)
    Set FirstCellVar = firstcell.Offset(0, j)
    survey = SurveyRngVar.Value
    
        For i = 1 To 46
            If InStr(1, indicators(i, 1).Value, survey) Then
            survey2 = indicators(i, 1).Value
                If IsEmpty(FirstCellVar) Then
                FirstCellVar.Value = survey2
                Else
                OutputVar.End(xlDown).Offset(1, 0).Value = survey2
                End If
            End If
        Next i
    
    Next j
    
    End Sub