Speed Up Loop in VBA

All,

Is there a faster way to perform the following two loops?

    Dim i As Long
    Dim j As Long

        'Combine Project Number and Job Number
        For i = 1 To 100
            If Range("D" & i).Value = "" Then GoTo Nexti
            If Range("A" & i).Value = "" And Range("B" & i).Value = "" And Range("C" & i).Value = "" And Range("D" & i).Value <> "" Then
                Range("D" & i - 2).Value = Range("D" & i).Value & " / " & Range("D" & i - 2).Value
                End If
Nexti:
            Next

        'Move Piece Counts + Frame Weight to job information row
        For j = 1 To 100
        If Range("A" & j).Value = "" Then GoTo Nextj
            If Range("A" & j).Value <> "" And Range("E" & j).Value <> "" Then
                Range("G" & j).Value = Range("G" & j + 1).Value 'BuiltUp
                Range("H" & j).Value = Range("H" & j + 1).Value 'HotRolled
                Range("I" & j).Value = Range("I" & j + 1).Value 'ColdFab
                Range("J" & j).Value = Range("J" & j + 1).Value 'HotDip
                End If
Nextj:
            Next

perhaps

   Dim i As Long

   'Combine Project Number and Job Number
   For i = 1 To 100
      If Range("A" & i).Value = "" Then
         If Range("D" & i).Value <> "" Then
            If Range("B" & i).Value = "" And Range("C" & i).Value = "" Then _
               Range("D" & i - 2).Value = Range("D" & i).Value & " / " & Range("D" & i - 2).Value
         End If
      Else
         If Range("E" & i).Value <> "" Then Range("G" & i).Resize(, 4).Value = Range("G" & i + 1).Resize(, 4).Value 'BuiltUp
      End If
   Next i

have you already turned off screenupdating?

Originally Posted by PY_

the second one depends on the first loop's changes.

in what way?

perhaps

   Dim i As Long
   Dim j As Long

'Move piece counts to job information row
   For i = 1 To 100
      If Range("A" & i).Value <> "" Then
         If Range("E" & i).Value <> "" Then Range("G" & i).Resize(, 4).Value = Range("G" & i + 1).Resize(, 4).Value
      End If
   Next i
   
   'Delete Rows with a blank cell in columnE
   Range("E1:E" & Cells(Rows.Count, "E").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   
   'Move Order ammount up to same line as job information
   For j = 100 To 1 Step -1
      If Range("A" & j).Value = "" Then
         If Range("B" & j).Value = "" Then
         ' already deleted blank cells in E
'            If Range("E" & j).Value <> "" Then
               Range("E" & j - 1).Value = Range("E" & j).Value
               Range("E" & j).EntireRow.Delete
'            End If
         End If
      End If
   Next j