xluser2007
11-04-2008, 01:44 AM
Hi All,
In a recent thread (http://vbaexpress.com/forum/showthread.php?t=23179) (which is still active), Krishna Kumar gave me the following code that I apply to CSV files to extend them in a particular fashion:
Option Explicit
Sub Extend_FOM_IBNRCSV()
'---------------------------------------------------
' DECLARE variables as we are using option explicit
'---------------------------------------------------
Dim a
Dim w()
Dim i As Long
Dim n As Long
Dim j As Long
Dim c As Long
Dim Flg As Boolean
a = Range("a1").CurrentRegion.Resize(, 4).Offset(1)
ReDim w(1 To Rows.Count, 1 To 4)
For i = 1 To UBound(a, 1)
n = n + 1
w(n, 1) = a(i, 1): w(n, 2) = a(i, 2)
w(n, 3) = a(i, 3): w(n, 4) = a(i, 4)
If a(i, 1) <> a(i + 1, 1) Then
Flg = True
End If
If Flg Then
For c = 1 To 6
For j = 1 To 131
n = n + 1
w(n, 1) = a(i - 1, 1): w(n, 2) = 8034 + c ' We are only updating to fieldA 8035 to 8040 for EACH State
w(n, 3) = a(j + i - 131, 3): w(n, 4) = a(j + i - 131, 4)
Next
Next
Flg = False
End If
If i = UBound(a, 1) - 1 Then Exit For
Next
With Range("a1")
.CurrentRegion.Offset(1).ClearContents
.Offset(1).Resize(n, 4).Value = w
End With
End Sub
The only change I need to make is to apply it to several CSV files, which I have stored as strings in my master workbook called master.xls.
In master.xls, I wish to modify Krishna's above macro to OPEN the relevant csv files and then apply the above macro for each worksheet in the opened csv file. Simple, right :)?
Well, here is what I have tried to do:
Option Explicit
Public Sub Extend_FOM_IBNRCSV(strsourcewbk As String)
'---------------------------------------------------
' DECLARE variables as we are using option explicit
'---------------------------------------------------
Dim a
Dim w()
Dim i As Long
Dim n As Long
Dim j As Long
Dim c As Long
Dim Flg As Boolean
Dim sourcewbk As Workbook
Dim wksht As Worksheet
Set sourcewbk = Workbooks.Open(strsourcewbk, UpdateLinks:=0)
For Each wksht In sourcewbk.Worksheets
a = sourcewbk.wksht.Range("a1").CurrentRegion.Resize(, 4).Offset(1)
ReDim w(1 To Rows.Count, 1 To 4)
For i = 1 To UBound(a, 1)
n = n + 1
w(n, 1) = a(i, 1): w(n, 2) = a(i, 2)
w(n, 3) = a(i, 3): w(n, 4) = a(i, 4)
If a(i, 1) <> a(i + 1, 1) Then
Flg = True
End If
If Flg Then
For c = 1 To 6
For j = 1 To 131
n = n + 1
w(n, 1) = a(i - 1, 1): w(n, 2) = 8034 + c ' We are only updating to fieldA 8035 to 8040 for EACH State
w(n, 3) = a(j + i - 131, 3): w(n, 4) = a(j + i - 131, 4)
Next
Next
Flg = False
End If
If i = UBound(a, 1) - 1 Then Exit For
Next
With sourcewbk.wksht.Range("a1")
.CurrentRegion.Offset(1).ClearContents
.Offset(1).Resize(n, 4).Value = w
End With
Next wksht
End Sub
In master.xls, I call the macro as follows:
Sub test()
Call Extend_FOM_IBNRCSV("C:\Type1.csv")
End Sub
This opens up the csv file successfully, but halts at the line with a "run-time error '424' - Object required"
It then highlights the following line:
a = sourcewbk.wksht.Range("a1").CurrentRegion.Resize(, 4).Offset(1)
Could anyone please explain where I am going wrong and how to correct the above please?
In a recent thread (http://vbaexpress.com/forum/showthread.php?t=23179) (which is still active), Krishna Kumar gave me the following code that I apply to CSV files to extend them in a particular fashion:
Option Explicit
Sub Extend_FOM_IBNRCSV()
'---------------------------------------------------
' DECLARE variables as we are using option explicit
'---------------------------------------------------
Dim a
Dim w()
Dim i As Long
Dim n As Long
Dim j As Long
Dim c As Long
Dim Flg As Boolean
a = Range("a1").CurrentRegion.Resize(, 4).Offset(1)
ReDim w(1 To Rows.Count, 1 To 4)
For i = 1 To UBound(a, 1)
n = n + 1
w(n, 1) = a(i, 1): w(n, 2) = a(i, 2)
w(n, 3) = a(i, 3): w(n, 4) = a(i, 4)
If a(i, 1) <> a(i + 1, 1) Then
Flg = True
End If
If Flg Then
For c = 1 To 6
For j = 1 To 131
n = n + 1
w(n, 1) = a(i - 1, 1): w(n, 2) = 8034 + c ' We are only updating to fieldA 8035 to 8040 for EACH State
w(n, 3) = a(j + i - 131, 3): w(n, 4) = a(j + i - 131, 4)
Next
Next
Flg = False
End If
If i = UBound(a, 1) - 1 Then Exit For
Next
With Range("a1")
.CurrentRegion.Offset(1).ClearContents
.Offset(1).Resize(n, 4).Value = w
End With
End Sub
The only change I need to make is to apply it to several CSV files, which I have stored as strings in my master workbook called master.xls.
In master.xls, I wish to modify Krishna's above macro to OPEN the relevant csv files and then apply the above macro for each worksheet in the opened csv file. Simple, right :)?
Well, here is what I have tried to do:
Option Explicit
Public Sub Extend_FOM_IBNRCSV(strsourcewbk As String)
'---------------------------------------------------
' DECLARE variables as we are using option explicit
'---------------------------------------------------
Dim a
Dim w()
Dim i As Long
Dim n As Long
Dim j As Long
Dim c As Long
Dim Flg As Boolean
Dim sourcewbk As Workbook
Dim wksht As Worksheet
Set sourcewbk = Workbooks.Open(strsourcewbk, UpdateLinks:=0)
For Each wksht In sourcewbk.Worksheets
a = sourcewbk.wksht.Range("a1").CurrentRegion.Resize(, 4).Offset(1)
ReDim w(1 To Rows.Count, 1 To 4)
For i = 1 To UBound(a, 1)
n = n + 1
w(n, 1) = a(i, 1): w(n, 2) = a(i, 2)
w(n, 3) = a(i, 3): w(n, 4) = a(i, 4)
If a(i, 1) <> a(i + 1, 1) Then
Flg = True
End If
If Flg Then
For c = 1 To 6
For j = 1 To 131
n = n + 1
w(n, 1) = a(i - 1, 1): w(n, 2) = 8034 + c ' We are only updating to fieldA 8035 to 8040 for EACH State
w(n, 3) = a(j + i - 131, 3): w(n, 4) = a(j + i - 131, 4)
Next
Next
Flg = False
End If
If i = UBound(a, 1) - 1 Then Exit For
Next
With sourcewbk.wksht.Range("a1")
.CurrentRegion.Offset(1).ClearContents
.Offset(1).Resize(n, 4).Value = w
End With
Next wksht
End Sub
In master.xls, I call the macro as follows:
Sub test()
Call Extend_FOM_IBNRCSV("C:\Type1.csv")
End Sub
This opens up the csv file successfully, but halts at the line with a "run-time error '424' - Object required"
It then highlights the following line:
a = sourcewbk.wksht.Range("a1").CurrentRegion.Resize(, 4).Offset(1)
Could anyone please explain where I am going wrong and how to correct the above please?