Copying Data Between Sheets

[Eratosthenes]

Hello all, I'm new here! Just a bit of background, if you're interested; I'm a novice programmer doing technical support for a printing company based in Missouri. I've been tasked with streamlining the processes of printing our box labels, and have hit a snag. Most of the issue comes from the fact that some, but not all, of our computers are Apples. It seems to me that the easiest way to get it to work I have to separate my VBA program from the data it needs to interact with, but this broke my program entirely and I can't seem to fix it no matter what I do.

Here is the code I was using before I tried to separate the files. I'm sorry, it's definitely a mess.

Private Sub EXPORT_Click()    Sheets("XML").Range("A1:C13530").Copy
        Sheets("UPS").Range("A1").PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Worksheets("UPS").Columns("B").Replace _
        What:="#REF!", Replacement:="BAD", _
        SearchOrder:=xlByColumns, MatchCase:=True
    Last = Cells(Rows.Count, "B").End(xlUp).row
        For i = Last To 1 Step -1
        If (Cells(i, "B").Value) = "BAD" Then
            Cells(i, "B").EntireRow.Delete
        End If
        Next i
    Columns("A:B").EntireColumn.Delete
    Dim xRet As Long
    Dim xFileName As Variant
    On Error GoTo ErrHandler
    xFileName = Application.GetSaveAsFilename(ActiveSheet.Name, "XML File (*.xml), *.xml", , "Worldship Exporter")
    If xFileName = False Then Exit Sub
    If Dir(xFileName) <> "" Then
        xRet = MsgBox("File '" & xFileName & "' exists.  Overwrite?", vbYesNo + vbExclamation, "Worldship Exporter")
        If xRet <> vbYes Then
            Exit Sub
        Else
            Kill xFileName
        End If
    End If
   
    SaveFile (xFileName)
   
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Worldship Exporter"
End Sub


Private Sub SaveFile(fileName)
    Dim fileNumber As Integer
    fileNumber = FreeFile
   
    On Error GoTo ReleaseFileAndThrowError
    Open fileName For Output As #fileNumber


    Dim row As Integer
    Dim cellText As String
    Do
        row = row + 1
        cellText = Cells(row, 1).Value
        Print #fileNumber, cellText
    Loop While Len(cellText) > 0


    Close #fileNumber
    Exit Sub


ReleaseFileAndThrowError:
    Close #fileNumber
    Err.Raise Err.Number
    Application.CutCopyMode = False
End Sub

What I'm trying to add here is a method of choosing a file from an explorer window to pull the data from, instead of pulling it from a sheet in the same workbook.

My attempt(s) looks like this, cut off where it becomes irrelevant.

Private Sub EXPORT_Click() Dim strFile As String
    Dim wbk As Workbook
    Dim lngLastRow As Long
    strFile = Application.GetOpenFilename
    If strFile = "False" Then
        Beep
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set wbk = Workbooks.Open(fileName:=strFile)
    With wbk.Worksheets(1)
        'lngLastRow = Sheets("XML").Range("A1:C13530").Copy
    End With
    Workbooks(strFile).Worksheets("XML").Range("A1:C13530").Copy _
    Workbooks("RLConverter.xlsm").Worksheets("UPS").Range("A1")
    'wbk.Close False
    'Sheets("UPS").Activate
    'Set wbk = Workbooks.Open("\\ARCADESERVER\Shared Folder 2\Jacob's Programming Files\RLConverter.xlsm")
        'Sheets("UPS").Range("A1").PasteSpecial _
        'Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        ':=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("UPS").Columns("B").Replace _
        What:="#REF!", Replacement:="BAD", _
        SearchOrder:=xlByColumns, MatchCase:=True
    Last = Sheets("UPS").Cells(Rows.Count, "B").End(xlUp).row
        For i = Last To 1 Step -1
        If (Sheets("UPS").Cells(i, "B").Value) = "BAD" Then
            Sheets("UPS").Cells(i, "B").EntireRow.Delete
        End If
        Next i
    Sheets("UPS").Columns("A:B").EntireColumn.Delete

Attached, hopefully, are the following files for reference;

Runlist Template: This is a working version of my code, contained within the same worksheet as the data.

RLConverter: This is the converter program, separated from the data, that currently doesn't work.



TLDR; I'm not really sure what I'm doing. I'm to copy data from a different workbook every use, do some stuff to it, then export it in XML format of use in uploading to another program. Please help!

[jolivanes]

Two same workbooks with empty sheets except one more sheet in one with data in three Columns.
Attach a workbook with a before and after and an explanation on how you arrived at the "after".

[siech]

Hello Eratosthenes,

I'm new too and a few months ago I would probably have written the same type of code as what you posted. So after learning, this is my first post in trying to give back and to continue my vba learning journey in doing it.
Basically you are trying to automatise in vba what you would do in Excel, but vba will work much better for you if you use arrays instead. Basically any of your scripts will work much faster if you:

1. Load your data in memory ( an array, collection, dictionary);
2. transform your data in memory;
3. write back to your sheet only when all is done;

So based on the above hereunder alternative version based on what I understood. What this script will do is:

1. Open an explorer window for the user to choose the source file
   Note: you will need to elaborate this as the "Application.GetOpenFilename" will not work on MAC! alternatively you could just show a msgBox asking the user to fill in manually the filename.
2. Load the data in memory and remove the lines with an "#REF!" error, it will also delete the first 2 cols.
3. write the modified data back to the sheet
4. Save the file as an xml file, using the tab name as filename. If the file already exists the user can decide not to save it, in that case the sub will just exit without closing the file
5. close the file

I commented most lines directly in the code.

best of luck,

Siech

Option Explicit
Option Base 1


Sub ImportData()
    'load the source file based on user input to an array
    Dim filename As String, Data, ws As Worksheet
    Set ws = Worksheets(1)
    filename = Application.GetOpenFilename
    Data = openfile(filename)
    
    'create a new target array based on the size of the original array minus the 2 colls we will delete
    Dim j As Long, jj As Long, i As Long, Tarr
    ReDim Tarr(1 To UBound(Data), 1 To UBound(Data, 2) - 2)
    
    For j = 1 To UBound(Data) 'loop trough the source lines
        jj = jj + 1 'set an alternative counter for the target array, this one will skip the lines we want to delete
        For i = 1 To UBound(Data, 2) - 2 'loop trough the cols of the source minus the 2 colls we want to delete
            j = IIf((CStr(Data(j, 2)) = "Error 2023"), j + 1, j) 'delete the line if "#REF!" error
            Tarr(jj, i) = Data(j, i + 2) 'set the source data in the target array. if a line must be deleted the jj counter will be e.g 2 vs 3 from the source
        Next i
    Next j
    
    'paste to sheet
    ws.Range("A1").Resize(jj, UBound(Tarr, 2)).Value2 = Tarr
    
    'Save
    On Error GoTo ErrorHandler 'if the user chooses to not overwrite the existing file we exit the sub
    ws.SaveAs filename:=ws.Name, FileFormat:=xlXMLSpreadsheet 'save as xml using the tabname, if the file exists the user will get a prompt
    ActiveWorkbook.Close savechanges:=False 'close the file
    
    'exit
ErrorHandler:
    Exit Sub
End Sub


Private Function openfile(filename As String) As Variant
    'import External
    Dim wbExt As Workbook, Data, FilePath As String
    'FilePath = Application.ActiveWorkbook.Path & filename => alternative if you just ask a filename to the user. this will set the path.
    Set wbExt = Workbooks.Open(filename:=filename) 'replace filename with filepath if you choose above approach
    With wbExt: Data = .Sheets(1).UsedRange.Value: .Close: End With 'get data from source and close
    openfile = Data 'send array back to main sub
End Function