VBA Makeshift Form Extraction Issue

Question

The purpose of my code is to loop through 1 folder copying from 40 plus excel type forms into a master datasheet. The extraction from the forms is by specific cells. Having an issue where if a cell is blank on form #1 then when data from form #2 is processed it’s data is pasted where data from form #1 should be. Can I please get some assistance on resolving this?

Also, the code is written basic as it is because I was instructed to do so as I am the only one on my team who knows VBA somewhat and they want to be able to quickly pick it up/ reference parts easily incase I am not here to fix it in the future.

Code:

'PURPOSE: To loop through all Excel files in a user specified folder and copy data values from 269a FSR sheet to the respective sheet in the MasterData file
'changes need to be made below in the Move269a statements

Dim wb As Workbook
Dim C269a As Worksheet
Dim P269a As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False

' Notify user of progress...
  oldStatusBar = Application.DisplayStatusBar
  Application.DisplayStatusBar = True
  Application.StatusBar = "Searching for files; please wait..."


'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(FileName:=myPath & myFile)

    'Ensure Workbook has opened before moving on to next line of code
      DoEvents

'*********Begin fill in 269a tab***********************************************
    Set C269a = wb.Sheets("269a")
    Set P269a = Workbooks("FSR_MasterData.xlsm").Worksheets("269a")

        'Report Activity D7
        C269a.Range("D7").Copy
        With P269a.Range("A" & Rows.Count).End(xlUp).Offset(1)
        .PasteSpecial Paste:=xlPasteColumnWidths
        .PasteSpecial Paste:=xlPasteValues
   End With
'Final Report A10
        C269a.Range("A10").Copy
        With P269a.Range("B" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Payee Vendor ID No.  E10
        C269a.Range("E10").Copy
        With P269a.Range("C" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Payee Name D11
        C269a.Range("D11").Copy
        With P269a.Range("D" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Address D13
        C269a.Range("D13").Copy
        With P269a.Range("E" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'City D15
        C269a.Range("D15").Copy
        With P269a.Range("F" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'State D18
        C269a.Range("D18").Copy
        With P269a.Range("G" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues

   End With
'Zip code D19
        C269a.Range("D19").Copy
        With P269a.Range("H" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues

   End With
'Contractor Name   F8
        C269a.Range("F8").Copy
        With P269a.Range("I" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'HHSC_Contract_Number J9
        C269a.Range("J9").Copy
        With P269a.Range("J" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Basis  H10
        C269a.Range("H10").Copy
        With P269a.Range("K" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Contract_From - BegDate H13
        C269a.Range("H13").Copy
        With P269a.Range("L" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Contract_To - EndDate  K13
        C269a.Range("K13").Copy
        With P269a.Range("M" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Period_From - BegDate H18
        C269a.Range("H18").Copy
        With P269a.Range("N" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Save and Close Workbook
      wb.Close SaveChanges:=False

    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "All data extracted from 269a complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.ScreenUpdating = True
   Application.StatusBar = False
   Application.DisplayStatusBar = oldStatusBar

End Sub```

Use a counter to increment the last row, instead of using `End(xlUp)` each time. — BigBen, Jan 29 '20 at 13:33

score 0 · Answer 1 · answered Jan 29 '20 at 13:40

It looks like the way how the data is being copied and pasted was you recording the macro from physically doing the actions. That works sometimes, but for something like this, I'd suggest using row counts++ and storing the values for each new row as variants from the data table into the new excel sheet. That way you can do a row = row + 1 where the new data will get pasted into the next row instead of on top of your previous data. This makes sure that the data gets pasted in and no data gets pasted over.

To be honest, you might need to have someone design this for you. Plenty of people on Upwork that could do this in a couple of hours.

These other Stack Overflow answers on another Stack Overflow questions might help you out too :)

VBA Makeshift Form Extraction Issue

1 Answers1