VBA Keeps Skipping a Paste

jondavis1987

Active Member
Joined
Dec 31, 2015
Messages
443
Office Version
  1. 2019
Platform
  1. Windows
So i have this section of vba.

VBA Code:
    '   Open destination workbook and capture it as destination workbook
    Workbooks.Open "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Misc\Gradations Changes\" & destName & ".xlsm"
    Set scndDestWB = Workbooks(destName)
   
    Application.DisplayAlerts = False
    For Each rg In scndDestWB.Sheets(wsName).Range("A1:Z100")
        If rg = srcName Then GoTo Found
    Next rg
   
Found:
   
    srcWS.Range("H31:H44").Copy
    rg.Offset(1, 0).PasteSpecial xlPasteValues
   
    '   Save changes and close destination workbook
    scndDestWB.Close SaveChanges:=True

It's inside of a larger one posted below. It's supposed to find a matching name and then copy H31:H44 and paste it underneath the matching name. it pastes everything but for some reason it pastes nothing for H33. It doesn't skip it. The workbook it's pasting in had a value there before and when the new range pastes on top of it the cell is just blank and all the rest are filled in. The cell appears to be formatted the same as the other cells in both the source workbook and the destination workbook. There's parts of the larger vba where the same range is pasted into a different workbook and H33 pastes the correct way. What can I do to get H33 to paste into the one workbook.


VBA Code:
Option Explicit

Sub Stockpiles()
   
    Dim srcWB        As Workbook
    Dim destWB       As Workbook
    Dim fName        As String
    Dim srcWS        As Worksheet
    Dim ws           As Worksheet
    Dim mstWS        As Worksheet
    Dim acWS         As Worksheet
    Dim destName     As String
    Dim wsName       As String
    Dim rg           As Range
    Dim srcName      As String
    Dim LocationName As String
    Dim scndDestWB   As Workbook
   
    Set srcWB = Workbooks("Stockpiles")
    Set srcWS = srcWB.Sheets("Stockpile Gradations")
    destName = srcWS.Range("D1").Text
    wsName = "Agg Gradations"
    srcName = srcWS.Range("C11")
    fName = Sheets("Stockpile Gradations").Range("C2").Value
   
    If srcWS.Range("C11").Value = "Crushed Asphalt" Then
        GoTo Crushed_Asphalt:
    End If
   
    '   Open destination workbook and capture it as destination workbook
    Workbooks.Open "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Aggregates\Stockpile Gradation\Stockpile Charts.xlsx"
    Set destWB = Workbooks("Stockpile Charts")
    Set ws = destWB.Sheets("Sheet1")
    Set mstWS = destWB.Sheets("Moistures")
    Set acWS = destWB.Sheets("AC")
   
    '   Unhide Sheet
    ws.Visible = True
    mstWS.Visible = True
    acWS.Visible = True
   
    '   Copy Sheet1 data from source workbook to destination workbook
    With ws
        .Range("A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).Resize(14, 1).Value = srcWS.Range("I11").Value
        .Range("D" & .Cells(Rows.Count, "D").End(xlUp).Row - 13).Resize(14, 1).Value = srcWS.Range("C9").Value
        .Range("E" & .Cells(Rows.Count, "E").End(xlUp).Row - 13).Resize(14, 1).Value = srcWS.Range("C11").Value
        .Range("F" & .Cells(Rows.Count, "F").End(xlUp).Row - 13).Resize(14).Value = srcWS.Range("A31:A44").Value
        .Range("G" & .Cells(Rows.Count, "G").End(xlUp).Row - 13).Resize(14).Value = srcWS.Range("J31:J44").Value
    End With
   
    '   Copy Moistures data from source workbook to destination workbook
    With mstWS
        .Range("A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).Value = srcWS.Range("I11").Value
        .Range("D" & .Cells(Rows.Count, "D").End(xlUp).Row + 0).Value = srcWS.Range("C9").Value
        .Range("E" & .Cells(Rows.Count, "E").End(xlUp).Row + 0).Value = srcWS.Range("C11").Value
        .Range("F" & .Cells(Rows.Count, "F").End(xlUp).Row + 0).Value = srcWS.Range("J18").Value
    End With
   
    '   Copy AC data from source workbook to destination workbook
   
    If srcWS.Range("I19").Value = "AC %" Then
        With acWS
            .Range("A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).Value = srcWS.Range("I11").Value
            .Range("D" & .Cells(Rows.Count, "D").End(xlUp).Row + 0).Value = srcWS.Range("C9").Value
            .Range("E" & .Cells(Rows.Count, "E").End(xlUp).Row + 0).Value = srcWS.Range("C11").Value
            .Range("F" & .Cells(Rows.Count, "F").End(xlUp).Row + 0).Value = srcWS.Range("J19").Value
        End With
       
       
    End If
   
    '   Hide Sheet
    ws.Visible = False
    mstWS.Visible = False
    acWS.Visible = False
   
    '   Save changes and close destination workbook
    destWB.Close SaveChanges:=True
   
    '   Open destination workbook and capture it as destination workbook
    Workbooks.Open "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Misc\Gradations Changes\" & destName & ".xlsm"
    Set scndDestWB = Workbooks(destName)
   
    Application.DisplayAlerts = False
    For Each rg In scndDestWB.Sheets(wsName).Range("A1:Z100")
        If rg = srcName Then GoTo Found
    Next rg
   
Found:
   
    srcWS.Range("H31:H44").Copy
    rg.Offset(1, 0).PasteSpecial xlPasteValues
   
    '   Save changes and close destination workbook
    scndDestWB.Close SaveChanges:=True
   
Crushed_Asphalt:
   
    '   Export source workbook to PDF
    With srcWB
       
        Sheets("Stockpile Gradations").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                          "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Aggregates\Stockpile Gradation\" & fName, Quality:=xlQualityStandard, _
                          includeDocProperties:=True, ignoreprintareas:=False, openafterpublish:=True
    End With
End Sub
 
BTW, do you see that your search code does not work?

VBA Code:
    Application.DisplayAlerts = False
    For Each rg In scndDestWB.Sheets(wsName).Range("A1:Z100")
        If rg = srcName Then GoTo Found
    Next rg

Found:

is always going to end up at Found: , even when rg = srcName is never true. You need to add some kind of escape path for when srcName is not found.

VBA Code:
    Application.DisplayAlerts = False
    For Each rg In scndDestWB.Sheets(wsName).Range("A1:Z100")
        If rg = srcName Then GoTo Found
    Next rg
    Exit Sub '<- something like this is needed 
Found:
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
BTW, do you see that your search code does not work?

VBA Code:
    Application.DisplayAlerts = False
    For Each rg In scndDestWB.Sheets(wsName).Range("A1:Z100")
        If rg = srcName Then GoTo Found
    Next rg

Found:

is always going to end up at Found: , even when rg = srcName is never true. You need to add some kind of escape path for when srcName is not found.

VBA Code:
    Application.DisplayAlerts = False
    For Each rg In scndDestWB.Sheets(wsName).Range("A1:Z100")
        If rg = srcName Then GoTo Found
    Next rg
    Exit Sub '<- something like this is needed
Found:
I didn't set that part of the code up because i didn't really understand the search function. Thank you for the advice, i'll get that set up. The value is always going to be found because it's part of a dropdown validation list with names that correspond but i'll add it anyway in case somebody screws up the list.
 
Upvote 0

Forum statistics

Threads
1,215,073
Messages
6,122,975
Members
449,095
Latest member
Mr Hughes

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top