Cyberopolus
New Member
- Joined
- Feb 2, 2017
- Messages
- 1
I have some VBA code that takes data from one excel file and places the data into a sheet of another excel file. The problem I'm having is some of the data is being converted into a date. I have tried turning off the "enable background error checking" and "Cells containing years represented as 2 digits". This has not prevented the data from converting to a date.
Below is the code. RawRetailSalesData is the sheet that I'm having an issue with. tdata(9,20) is the value that is getting converted.
Thanks for your help
Sub opendatasheets()
'''''Define Object for Target Workbook
Dim TwB As Workbook '' Target workbook object
Dim SwB As Workbook '' source workbook object
Dim TPath As String '' target path user defined
'''''Assign the Workbook File Name along with its Path
TPath = Application.GetOpenFilename(, , "Select Sales Data File")
If TPath = "False" Then
MsgBox "No File Selected, Please Try Again"
Exit Sub
End If
Set SwB = ThisWorkbook
Set TwB = Workbooks.Open(TPath)
On Error Resume Next
TwB.Sheets("retail").Select
If Err.Number <> 0 Then
MsgBox "The data source requires sheets to be named 'Retail', 'Wholesale'. Please try again with properly formated data"
Exit Sub
End If
r = Selection.End(xlDown).Row '' determine the size of the data
c = Selection.End(xlToRight).Column
'' Turn of Screen updates to speed up the process
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'''''Read Data from Target File
tdata = TwB.Sheets("retail").Range(Cells(1, 1), Cells(r, c)).Value
SwB.Sheets("RawRetailSalesData").Cells.Clear
For i = 1 To r
SwB.Sheets("RawRetailSalesData").Cells(i, 1).Value = tdata(i, 1)
For x = 1 To c
SwB.Sheets("RawRetailSalesData").Cells(i, x).Value = tdata(i, x)
Next x
Next i
'''''Close Target Workbook
TwB.Close False
''' RawRetailSalesData is now updated from user defined workbook
'' open the data file for active inventory
TPath = Application.GetOpenFilename(, , "Select Inventory Data File")
If TPath = "False" Then
MsgBox "No File Selected, Please Try Again"
Exit Sub
End If
Set TwB = Workbooks.Open(TPath)
'' name of sheets to variable to test for errors
n = ActiveWorkbook.Sheets.Count
Dim ws()
ReDim Preserve ws '' number of sheets in the workbook
For Z = 1 To n
ws(Z) = TwB.Sheets(Z).Name '' array with name of each work sheet in workbook
Next Z
'' set up counter and loop through all sheets for placement of data
For s = 1 To n '' n is number of sheets in workbook
Select Case ws > 1
Case Left(ws(s), 1) = "A"
TwB.Sheets(ws(s)).Select
Range("A1").Select
r = Selection.End(xlDown).Row '' determine the size of the data
c = Selection.End(xlToRight).Column
tdata = TwB.Sheets(ws(s)).Range(Cells(1, 1), Cells(r, c)).Value
SwB.Sheets("Active").Cells.Clear
For m = 1 To r
SwB.Sheets("Active").Cells(m, 1).Value = tdata(m, 1)
For x = 1 To c
SwB.Sheets("Active").Cells(m, x).Value = tdata(m, x)
Next x
Next m
Case Left(ws(s), 1) = "I"
'' Update In Progress Inventory
TwB.Sheets(ws(s)).Select
Range("A1").Select
r = Selection.End(xlDown).Row '' determine the size of the data
c = Selection.End(xlToRight).Column
tdata = TwB.Sheets(ws(s)).Range(Cells(1, 1), Cells(r, c)).Value
SwB.Sheets("In Progress").Cells.Clear
For m = 1 To r
SwB.Sheets("In Progress").Cells(m, 1).Value = tdata(m, 1)
For x = 1 To c
SwB.Sheets("In Progress").Cells(m, x).Value = tdata(m, x)
Next x
Next m
Case Left(ws(s), 1) = "W"
' Update Wholesale Inventory
TwB.Sheets(ws(s)).Select
Range("A1").Select
r = Selection.End(xlDown).Row '' determine the size of the data
c = Selection.End(xlToRight).Column
tdata = TwB.Sheets(ws(s)).Range(Cells(1, 1), Cells(r, c)).Value
SwB.Sheets("Wholesale").Cells.Clear
For m = 1 To r
SwB.Sheets("Wholesale").Cells(m, 1).Value = tdata(m, 1)
For x = 1 To c
SwB.Sheets("Wholesale").Cells(m, x).Value = tdata(m, x)
Next x
Next m
End Select
Next s
'''''Close Target Workbook
TwB.Close False
Application.ScreenUpdating = True '' screen on
Application.Calculation = xlCalculationAutomatic
Calculate
End Sub
Below is the code. RawRetailSalesData is the sheet that I'm having an issue with. tdata(9,20) is the value that is getting converted.
Thanks for your help
Sub opendatasheets()
'''''Define Object for Target Workbook
Dim TwB As Workbook '' Target workbook object
Dim SwB As Workbook '' source workbook object
Dim TPath As String '' target path user defined
'''''Assign the Workbook File Name along with its Path
TPath = Application.GetOpenFilename(, , "Select Sales Data File")
If TPath = "False" Then
MsgBox "No File Selected, Please Try Again"
Exit Sub
End If
Set SwB = ThisWorkbook
Set TwB = Workbooks.Open(TPath)
On Error Resume Next
TwB.Sheets("retail").Select
If Err.Number <> 0 Then
MsgBox "The data source requires sheets to be named 'Retail', 'Wholesale'. Please try again with properly formated data"
Exit Sub
End If
r = Selection.End(xlDown).Row '' determine the size of the data
c = Selection.End(xlToRight).Column
'' Turn of Screen updates to speed up the process
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'''''Read Data from Target File
tdata = TwB.Sheets("retail").Range(Cells(1, 1), Cells(r, c)).Value
SwB.Sheets("RawRetailSalesData").Cells.Clear
For i = 1 To r
SwB.Sheets("RawRetailSalesData").Cells(i, 1).Value = tdata(i, 1)
For x = 1 To c
SwB.Sheets("RawRetailSalesData").Cells(i, x).Value = tdata(i, x)
Next x
Next i
'''''Close Target Workbook
TwB.Close False
''' RawRetailSalesData is now updated from user defined workbook
'' open the data file for active inventory
TPath = Application.GetOpenFilename(, , "Select Inventory Data File")
If TPath = "False" Then
MsgBox "No File Selected, Please Try Again"
Exit Sub
End If
Set TwB = Workbooks.Open(TPath)
'' name of sheets to variable to test for errors
n = ActiveWorkbook.Sheets.Count
Dim ws()
ReDim Preserve ws '' number of sheets in the workbook
For Z = 1 To n
ws(Z) = TwB.Sheets(Z).Name '' array with name of each work sheet in workbook
Next Z
'' set up counter and loop through all sheets for placement of data
For s = 1 To n '' n is number of sheets in workbook
Select Case ws > 1
Case Left(ws(s), 1) = "A"
TwB.Sheets(ws(s)).Select
Range("A1").Select
r = Selection.End(xlDown).Row '' determine the size of the data
c = Selection.End(xlToRight).Column
tdata = TwB.Sheets(ws(s)).Range(Cells(1, 1), Cells(r, c)).Value
SwB.Sheets("Active").Cells.Clear
For m = 1 To r
SwB.Sheets("Active").Cells(m, 1).Value = tdata(m, 1)
For x = 1 To c
SwB.Sheets("Active").Cells(m, x).Value = tdata(m, x)
Next x
Next m
Case Left(ws(s), 1) = "I"
'' Update In Progress Inventory
TwB.Sheets(ws(s)).Select
Range("A1").Select
r = Selection.End(xlDown).Row '' determine the size of the data
c = Selection.End(xlToRight).Column
tdata = TwB.Sheets(ws(s)).Range(Cells(1, 1), Cells(r, c)).Value
SwB.Sheets("In Progress").Cells.Clear
For m = 1 To r
SwB.Sheets("In Progress").Cells(m, 1).Value = tdata(m, 1)
For x = 1 To c
SwB.Sheets("In Progress").Cells(m, x).Value = tdata(m, x)
Next x
Next m
Case Left(ws(s), 1) = "W"
' Update Wholesale Inventory
TwB.Sheets(ws(s)).Select
Range("A1").Select
r = Selection.End(xlDown).Row '' determine the size of the data
c = Selection.End(xlToRight).Column
tdata = TwB.Sheets(ws(s)).Range(Cells(1, 1), Cells(r, c)).Value
SwB.Sheets("Wholesale").Cells.Clear
For m = 1 To r
SwB.Sheets("Wholesale").Cells(m, 1).Value = tdata(m, 1)
For x = 1 To c
SwB.Sheets("Wholesale").Cells(m, x).Value = tdata(m, x)
Next x
Next m
End Select
Next s
'''''Close Target Workbook
TwB.Close False
Application.ScreenUpdating = True '' screen on
Application.Calculation = xlCalculationAutomatic
Calculate
End Sub