VBA code selecting a range with a blank cell

[Skooks]

Hi all first time poster. Been getting some great tips and lessons from the board but i'm stuck on some VBA code.

I have pieced together and modified some code to do a task i'm after but one section i can't get to work.
I'm not good at writing VBA but i'm capable of modifying something to work. sometimes

i call this below macro from another macro and it works up until it comes across a blank cell in a column D of the spreadsheet

It essentially looks down the D column starting with D5 and if the cell has a number in it it then looks for a PDF file in one folder and if it exists moves it to another folder. Then moves onto the next cell. The issue is if ( for example) the first 5 cells have numbers in them it works flawlessly but if the 6th cell is blank and the 7th cell has numbers in it the file relating to the 7th cell doesnt get moved. I'm assuming i need to specify a better range but not sure how i do that. Im guessing but assuming the current code ( in code language) says " keep looping down the D column until it comes across a blank cell then stop" ... how do i change that to keep looping until D150 or similar ?

Sub Movefile()
Dim rng As Range
Dim oldPath As String
Dim newPath As String
Dim oldFile As String
Dim newFile As String
Dim Foldermonth As String

'================================================
'Set the paths to the folders you are processing
'REMEMBER END BACKSLASH
'================================================
oldPath = "C:\Users\larry\Documents\VBA test folder\Purchase order"
newPath = "C:\Users\larry\Documents\VBA test folder\Purchase order"
Foldermonth = ActiveSheet.Range("B2").Value

'=======================================================
'set up the start of the range you want to loop through
'EDIT SHEET NAME AND FIRST CELL ADDRESS IF NECESSARY
'======================================================
Set rng = ActiveSheet.Range("E5")

'==================================================
'loop through column B until you find an empty cell
'==================================================
Do Until rng = ""

'build up the full path to the old file
oldFile = oldPath & "" & rng.Value & ".pdf"

'build up the full path to the new file you want to create
newFile = newPath & "" & Foldermonth & "" & rng.Value & "" & rng.Value & ".pdf"

'copy the old file to the new new folder
If Len(Dir(oldFile, vbDirectory)) > 0 Then
FileCopy oldFile, newFile
Kill (oldFile)
End If
'get the next file by moving down one row
Set rng = rng.Offset(1, 0)
Loop
End Sub



Thanks in advance for any help

 

[Fluff]

Missing an End If

Sub Movefile()
Dim rng As Range
Dim oldPath As String
Dim newPath As String
Dim oldFile As String
Dim newFile As String
Dim Foldermonth As String
Dim LastCell As Range
Dim LoopRng As Range
Dim Cell As Range

'================================================
'Set the paths to the folders you are processing
'REMEMBER END BACKSLASH
'================================================
oldPath = "C:\Users\larry\Documents\VBA test folder\Purchase order"
newPath = "C:\Users\larry\Documents\VBA test folder\Purchase order"
Foldermonth = ActiveSheet.Range("B2").Value


'=======================================================
'set up the start of the range you want to loop through
'EDIT SHEET NAME AND FIRST CELL ADDRESS IF NECESSARY
'======================================================
Set rng = ActiveSheet.Range("E5")
Set LastCell = ActiveSheet.Cells(Rows.Count, rng.column).End(xlUp)
Set LoopRng = ActiveSheet.Range(rng, LastCell)


'==================================================
'loop through column B until you find an empty cell
'==================================================
For Each Cell In LoopRng
   
   
   If Not IsEmpty(Cell) Then
   
      
      'build up the full path to the old file
      oldFile = oldPath & "\" & Cell.Value & ".pdf"
      
      
      'build up the full path to the new file you want to create
      newFile = newPath & "\" & Foldermonth & "\" & Cell.Value & "\" & Cell.Value & ".pdf"
      
      
      'copy the old file to the new new folder
      If Len(Dir(oldFile, vbDirectory)) > 0 Then
         FileCopy oldFile, newFile
         Kill (oldFile)
      End If
  [COLOR=#ff0000] End If[/COLOR]
   
Next Cell
End Sub

 

[Skooks]

that done the trick, thanks fluff, works good now. Appreciate your replies

 

[Fluff]

Glad to help & thanks for the feedback