Can this code be cleaned up?

**bhodge10** · 07-14-2011, 10:42 AM

I've got a quote template and it automatically populates a different workbook via the below code. But that is a lot of lines, is there anyway to clean this up and achieve the same thing? The code works perfectly, but there is just a lot of lines. This code only shows the first 10 data sets, but actually there are 30 in total. Thanks.

Option Explicit

Sub endofcontractadd()

'where it says Activecell.offset, this is on workbook B, but where it says "ThisWorkBook", this data 'is on Workbook A. 
     '1
    If ThisWorkbook.Sheets("Data").Range("F175").Value <> "" Then
        ActiveCell.Offset(0, 4).Value = ThisWorkbook.Sheets("Data").Range("F175").Value
        ActiveCell.Offset(0, 5).Value = ThisWorkbook.Sheets("Data").Range("G175").Value
        ActiveCell.Offset(0, 6).Value = ThisWorkbook.Sheets("Data").Range("H175").Value
    End If
    '2
    If ThisWorkbook.Sheets("Data").Range("F176").Value <> "" Then
        ActiveCell.Offset(0, 7).Value = ThisWorkbook.Sheets("Data").Range("F176").Value
        ActiveCell.Offset(0, 8).Value = ThisWorkbook.Sheets("Data").Range("G176").Value
        ActiveCell.Offset(0, 9).Value = ThisWorkbook.Sheets("Data").Range("H176").Value
    End If
    '3
    If ThisWorkbook.Sheets("Data").Range("F177").Value <> "" Then
        ActiveCell.Offset(0, 10).Value = ThisWorkbook.Sheets("Data").Range("F177").Value
        ActiveCell.Offset(0, 11).Value = ThisWorkbook.Sheets("Data").Range("G177").Value
        ActiveCell.Offset(0, 12).Value = ThisWorkbook.Sheets("Data").Range("H177").Value
    End If
    '4
    If ThisWorkbook.Sheets("Data").Range("F178").Value <> "" Then
        ActiveCell.Offset(0, 13).Value = ThisWorkbook.Sheets("Data").Range("F178").Value
        ActiveCell.Offset(0, 14).Value = ThisWorkbook.Sheets("Data").Range("G178").Value
        ActiveCell.Offset(0, 15).Value = ThisWorkbook.Sheets("Data").Range("H178").Value
    End If
    '5
    If ThisWorkbook.Sheets("Data").Range("F179").Value <> "" Then
        ActiveCell.Offset(0, 16).Value = ThisWorkbook.Sheets("Data").Range("F179").Value
        ActiveCell.Offset(0, 17).Value = ThisWorkbook.Sheets("Data").Range("G179").Value
        ActiveCell.Offset(0, 18).Value = ThisWorkbook.Sheets("Data").Range("H179").Value
    End If
    '6
    If ThisWorkbook.Sheets("Data").Range("F180").Value <> "" Then
        ActiveCell.Offset(0, 19).Value = ThisWorkbook.Sheets("Data").Range("F180").Value
        ActiveCell.Offset(0, 20).Value = ThisWorkbook.Sheets("Data").Range("G180").Value
        ActiveCell.Offset(0, 21).Value = ThisWorkbook.Sheets("Data").Range("H180").Value
    End If
    '7
    If ThisWorkbook.Sheets("Data").Range("F181").Value <> "" Then
        ActiveCell.Offset(0, 22).Value = ThisWorkbook.Sheets("Data").Range("F181").Value
        ActiveCell.Offset(0, 23).Value = ThisWorkbook.Sheets("Data").Range("G181").Value
        ActiveCell.Offset(0, 24).Value = ThisWorkbook.Sheets("Data").Range("H181").Value
    End If
    '8
    If ThisWorkbook.Sheets("Data").Range("F182").Value <> "" Then
        ActiveCell.Offset(0, 25).Value = ThisWorkbook.Sheets("Data").Range("F182").Value
        ActiveCell.Offset(0, 26).Value = ThisWorkbook.Sheets("Data").Range("G182").Value
        ActiveCell.Offset(0, 27).Value = ThisWorkbook.Sheets("Data").Range("H182").Value
    End If
    '9
    If ThisWorkbook.Sheets("Data").Range("F183").Value <> "" Then
        ActiveCell.Offset(0, 28).Value = ThisWorkbook.Sheets("Data").Range("F183").Value
        ActiveCell.Offset(0, 29).Value = ThisWorkbook.Sheets("Data").Range("G183").Value
        ActiveCell.Offset(0, 30).Value = ThisWorkbook.Sheets("Data").Range("H183").Value
    End If
    '10
    If ThisWorkbook.Sheets("Data").Range("F184").Value <> "" Then
        ActiveCell.Offset(0, 31).Value = ThisWorkbook.Sheets("Data").Range("F184").Value
        ActiveCell.Offset(0, 32).Value = ThisWorkbook.Sheets("Data").Range("G184").Value
        ActiveCell.Offset(0, 33).Value = ThisWorkbook.Sheets("Data").Range("H184").Value
    End If
 

End Sub

**davegugg** · 07-14-2011, 10:51 AM

Sub endofcontractadd()

    Dim i As Integer
    
    With ThisWorkbook.Sheets("Data")
        For i = 175 To 184
            If .Cells(i, "F").Value <> "" Then
                ActiveCell.Offset(0, 3 * (i - 174) + 1).Value = .Cells(i, "F").Value
                ActiveCell.Offset(0, 3 * (i - 174) + 2).Value = .Cells(i, "G").Value
                ActiveCell.Offset(0, 3 * (i - 174) + 3).Value = .Cells(i, "H").Value
            End If
        Next i
    End With
     
End Sub