Eratosthenes
02-06-2021, 12:45 PM
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!
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!