tucsondonpepe
New Member
- Joined
- Jan 30, 2022
- Messages
- 43
- Office Version
- 365
- Platform
- Windows
- Web
Hi,
I am receiving the error message shown in the attached image.
The error occurs at this point in the subroutine:
Workbooks("E:\Downloads\Games Won\8-2022 Spring Season Games Won.xlsx").Worksheets("Sheet1").Range("A1:I1000").Copy _
Workbooks("2022-2-Bocce-Spring-Data.xlsm").Worksheets("Sheet1").Range("A1")
Joe
Sub Import_Games_Won_Data()
'
' ===========================================
'
Dim FileNames(10) As String
Dim Index As Integer
Dim LeagueNames(16) As String
Dim NewFileName As String
Dim newName
Dim NumFiles As Integer
Dim oFile As Object
Dim oFolder As Object
Dim oFSO As Object
Dim oldName
Dim OriginalFileName As String
Dim Path As String
Dim Wkb As Workbook
'
' ============================================
' The xlsx file in the E:\Downloads\Games Won\
' folder needs to be in the following format
'
' 8-2022 Spring Season Games Won.xlsx
' (35 characters)
' (30 characters without the extension)
'
' Since MS Forms appends additional characters
' every time the file is downloaded, the number
' of characters increases
'
' Two examples:
'
' 8-2022 Spring Season Games Won(1-234).xlsx
' 8-2022 Spring Season Games Won(1-234)(1).xlsx
'
' At this time, the file must be edited prior to being processed
' by the macro to the following:
'
' 8-2022 Spring Season Games Won.xlsx
' ============================================
'
' ====================================
' Fetch LeagueNames from Leagues sheet
' ====================================
'
Sheets("Leagues").Select
For N = 1 To 16
LeagueNames(N) = Range("A" & (N + 1))
Next N
Dim file As Variant
Dim i As Integer
Dim strDir As String
Dim strType As String
'
' ==========================
' If the "\" is missing, add it
' ==========================
'
strDir = "E:\Downloads\Games Won\"
strType = "*xlsx"
If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
file = Dir(strDir & strType)
'
' ===============
' Count the files
' ===============
'
i = 0
While (file <> "")
i = i + 1
file = Dir
Wend
'
MsgBox i
'
NumFiles = i
'
' ===================================
' If there are 0 files in the folder,
' call Function ErrorMessage(104)
' ===================================
'
If NumFiles = 0 Then GoTo Skip104
'
' =====================================
' Only one file should be in the folder.
' If there is more than one file,
' call Function ErrorMessage(105)
' =====================================
'
If NumFiles > 1 Then GoTo Skip105
'
'
' ===============================
' Since there is only 1 file, we can continue
' ===============================
'
'
' ===========================================================
' Open workbook,8-2022 Spring Season Games Won.xlsx, in the Downloads folder
' ==========================================================
'
' Workbooks("E:\Downloads\Games Won\8-2022 Spring Season Games Won.xlsx").Activate
' Set Wkb = Workbooks.Open("E:\Downloads\Games Won\8-2022 Spring Season Games Won.xlsx")
' Workbooks.Open (filename:=fldrpath & myfilname)
Workbooks.Open ("E:\Downloads\Games Won\8-2022 Spring Season Games Won.xlsx")
Workbooks("2022-2-Bocce-Spring-Data.xlsm").Activate
'
' ==========================================
' Copy data
'
' from
' Sheet1 in 8-2022 Spring Season Games Won.xlsx
' to
' Sheet1 in 2022-2-Bocce-Spring-Data.xlsm
' ==========================================
' Workbooks("New Data.xlsx").Worksheets("Export").Range("A2:D9").Copy _
' Workbooks("Reports.xlsm").Worksheets("Data").Range("A2")
Workbooks("E:\Downloads\Games Won\8-2022 Spring Season Games Won.xlsx").Worksheets("Sheet1").Range("A1:I1000").Copy _
Workbooks("2022-2-Bocce-Spring-Data.xlsm").Worksheets("Sheet1").Range("A1")
'
' ===========================================
' Now do the following:
'
' 1 - Delete columns A:E
' 2 - Calculates the number of
' characters in the first column
' 3 - Determines the location of the ","
' 4 - Determines the number of characters
' to delete from the right
' ===========================================
'
Sheets("Sheet1").Select
Columns("A:E").Delete
Range("A1").Select
'
' ============================
' Do not copy the header row 1
' ============================
'
NumRows = Cells(Rows.Count, 1).End(xlUp).Row
For N = 2 To NumRows
NumCharacters = Len(Range("A" & N))
LocationOfComma = InStrRev(Range("A" & N), ",")
CharactersToDelete = NumCharacters - LocationOfComma
Range("A" & N) = Left(Range("A" & N), Len(Range("A" & N)) - CharactersToDelete - 1)
Next N
'
' =============================================
' Change format from text to number in column D
' =============================================
'
For N = 2 To NumRows
Range("D" & N) = Range("D" & N) * 1
Next N
'
' ==============================
' Switch to Sheet 2 and clear it
' ==============================
'
Sheets("Sheet2").Select
Cells.Clear
'
' ======================
' Copy Sheet 1 to Sheet2
' ======================
'
Sheets("Sheet1").Select
Range("A1:D" & NumRows).Copy
Sheets("Sheet2").Select
With ActiveSheet.Range("A1:D" & NumRows)
.PasteSpecial xlPasteValues
End With
'
' =========================
' Move column A to column E
' =========================
'
Columns("A:A").Cut
Columns("E:E").Insert
'
' ===============================================
' Add two lines for each league. This enables the
' calculations to proceed even when there is no
' Games Won data. This happens at the beginning
' of a season.
' ===============================================
'
NumRows = NumRows + 1
For N = 1 To 16
For M = 1 To 2
Range("A" & NumRows) = LeagueNames(N)
Range("B" & NumRows) = "Week 1"
Range("C" & NumRows) = 0
Range("D" & NumRows) = "Blank"
NumRows = NumRows + 1
Next M
Next N
'
' ============================
' Delete row 1, the header row
' ============================
'
Sheets("Sheet2").Select
Rows("1").Delete
NumRows = NumRows - 1
'
' ===============================================
' Sort the data on League(A), Week(B), Captain(D)
' ===============================================
'
Sheets("Sheet2").Select
Range("A1:D" & NumRows).Sort _
Key1:=Range("A1:A" & NumRows), Order1:=xlAscending, _
Key2:=Range("B1:B" & NumRows), Order1:=xlAscending, _
Key3:=Range("C1:C" & NumRows), Order1:=xlAscending, _
Header:=xlNo
'
' =======================================
' Copy data from Sheet2 to Games Won Data
' =======================================
'
Sheets("Sheet2").Select
Range("A1:D" & NumRows).Copy
Sheets("Games Won Data").Select
Range("A1").Select
ActiveSheet.Paste
'
' ==============
' Trim the cells
' ==============
'
For Each cell In Range("A1:D" & NumRows)
cell.Value = Trim(cell)
Next
GoTo TheEnd
Skip104:
Call ErrorMessage(104)
GoTo TheEnd
Skip105:
Call ErrorMessage(105)
TheEnd:
End Sub
I am receiving the error message shown in the attached image.
The error occurs at this point in the subroutine:
Workbooks("E:\Downloads\Games Won\8-2022 Spring Season Games Won.xlsx").Worksheets("Sheet1").Range("A1:I1000").Copy _
Workbooks("2022-2-Bocce-Spring-Data.xlsm").Worksheets("Sheet1").Range("A1")
Joe
Sub Import_Games_Won_Data()
'
' ===========================================
'
Dim FileNames(10) As String
Dim Index As Integer
Dim LeagueNames(16) As String
Dim NewFileName As String
Dim newName
Dim NumFiles As Integer
Dim oFile As Object
Dim oFolder As Object
Dim oFSO As Object
Dim oldName
Dim OriginalFileName As String
Dim Path As String
Dim Wkb As Workbook
'
' ============================================
' The xlsx file in the E:\Downloads\Games Won\
' folder needs to be in the following format
'
' 8-2022 Spring Season Games Won.xlsx
' (35 characters)
' (30 characters without the extension)
'
' Since MS Forms appends additional characters
' every time the file is downloaded, the number
' of characters increases
'
' Two examples:
'
' 8-2022 Spring Season Games Won(1-234).xlsx
' 8-2022 Spring Season Games Won(1-234)(1).xlsx
'
' At this time, the file must be edited prior to being processed
' by the macro to the following:
'
' 8-2022 Spring Season Games Won.xlsx
' ============================================
'
' ====================================
' Fetch LeagueNames from Leagues sheet
' ====================================
'
Sheets("Leagues").Select
For N = 1 To 16
LeagueNames(N) = Range("A" & (N + 1))
Next N
Dim file As Variant
Dim i As Integer
Dim strDir As String
Dim strType As String
'
' ==========================
' If the "\" is missing, add it
' ==========================
'
strDir = "E:\Downloads\Games Won\"
strType = "*xlsx"
If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
file = Dir(strDir & strType)
'
' ===============
' Count the files
' ===============
'
i = 0
While (file <> "")
i = i + 1
file = Dir
Wend
'
MsgBox i
'
NumFiles = i
'
' ===================================
' If there are 0 files in the folder,
' call Function ErrorMessage(104)
' ===================================
'
If NumFiles = 0 Then GoTo Skip104
'
' =====================================
' Only one file should be in the folder.
' If there is more than one file,
' call Function ErrorMessage(105)
' =====================================
'
If NumFiles > 1 Then GoTo Skip105
'
'
' ===============================
' Since there is only 1 file, we can continue
' ===============================
'
'
' ===========================================================
' Open workbook,8-2022 Spring Season Games Won.xlsx, in the Downloads folder
' ==========================================================
'
' Workbooks("E:\Downloads\Games Won\8-2022 Spring Season Games Won.xlsx").Activate
' Set Wkb = Workbooks.Open("E:\Downloads\Games Won\8-2022 Spring Season Games Won.xlsx")
' Workbooks.Open (filename:=fldrpath & myfilname)
Workbooks.Open ("E:\Downloads\Games Won\8-2022 Spring Season Games Won.xlsx")
Workbooks("2022-2-Bocce-Spring-Data.xlsm").Activate
'
' ==========================================
' Copy data
'
' from
' Sheet1 in 8-2022 Spring Season Games Won.xlsx
' to
' Sheet1 in 2022-2-Bocce-Spring-Data.xlsm
' ==========================================
' Workbooks("New Data.xlsx").Worksheets("Export").Range("A2:D9").Copy _
' Workbooks("Reports.xlsm").Worksheets("Data").Range("A2")
Workbooks("E:\Downloads\Games Won\8-2022 Spring Season Games Won.xlsx").Worksheets("Sheet1").Range("A1:I1000").Copy _
Workbooks("2022-2-Bocce-Spring-Data.xlsm").Worksheets("Sheet1").Range("A1")
'
' ===========================================
' Now do the following:
'
' 1 - Delete columns A:E
' 2 - Calculates the number of
' characters in the first column
' 3 - Determines the location of the ","
' 4 - Determines the number of characters
' to delete from the right
' ===========================================
'
Sheets("Sheet1").Select
Columns("A:E").Delete
Range("A1").Select
'
' ============================
' Do not copy the header row 1
' ============================
'
NumRows = Cells(Rows.Count, 1).End(xlUp).Row
For N = 2 To NumRows
NumCharacters = Len(Range("A" & N))
LocationOfComma = InStrRev(Range("A" & N), ",")
CharactersToDelete = NumCharacters - LocationOfComma
Range("A" & N) = Left(Range("A" & N), Len(Range("A" & N)) - CharactersToDelete - 1)
Next N
'
' =============================================
' Change format from text to number in column D
' =============================================
'
For N = 2 To NumRows
Range("D" & N) = Range("D" & N) * 1
Next N
'
' ==============================
' Switch to Sheet 2 and clear it
' ==============================
'
Sheets("Sheet2").Select
Cells.Clear
'
' ======================
' Copy Sheet 1 to Sheet2
' ======================
'
Sheets("Sheet1").Select
Range("A1:D" & NumRows).Copy
Sheets("Sheet2").Select
With ActiveSheet.Range("A1:D" & NumRows)
.PasteSpecial xlPasteValues
End With
'
' =========================
' Move column A to column E
' =========================
'
Columns("A:A").Cut
Columns("E:E").Insert
'
' ===============================================
' Add two lines for each league. This enables the
' calculations to proceed even when there is no
' Games Won data. This happens at the beginning
' of a season.
' ===============================================
'
NumRows = NumRows + 1
For N = 1 To 16
For M = 1 To 2
Range("A" & NumRows) = LeagueNames(N)
Range("B" & NumRows) = "Week 1"
Range("C" & NumRows) = 0
Range("D" & NumRows) = "Blank"
NumRows = NumRows + 1
Next M
Next N
'
' ============================
' Delete row 1, the header row
' ============================
'
Sheets("Sheet2").Select
Rows("1").Delete
NumRows = NumRows - 1
'
' ===============================================
' Sort the data on League(A), Week(B), Captain(D)
' ===============================================
'
Sheets("Sheet2").Select
Range("A1:D" & NumRows).Sort _
Key1:=Range("A1:A" & NumRows), Order1:=xlAscending, _
Key2:=Range("B1:B" & NumRows), Order1:=xlAscending, _
Key3:=Range("C1:C" & NumRows), Order1:=xlAscending, _
Header:=xlNo
'
' =======================================
' Copy data from Sheet2 to Games Won Data
' =======================================
'
Sheets("Sheet2").Select
Range("A1:D" & NumRows).Copy
Sheets("Games Won Data").Select
Range("A1").Select
ActiveSheet.Paste
'
' ==============
' Trim the cells
' ==============
'
For Each cell In Range("A1:D" & NumRows)
cell.Value = Trim(cell)
Next
GoTo TheEnd
Skip104:
Call ErrorMessage(104)
GoTo TheEnd
Skip105:
Call ErrorMessage(105)
TheEnd:
End Sub