Extending/ Adjusting CSV files using VBA

[xluser2007]

Hi All,

I have attached a sample file (CSV) as below (Type A.csv).

In this particular file we have 4 columns:

State fieldA fieldB Numberfield
There is a strict order in which the values for each column as you move down. And also the fields are ordered in a specific way.

There can be a number of states for each CSV, in this example there are 2 states, called 1 and 2.

Next is the fieldA. For each state the fieldA values range from 7947 to 8034.

For each state and fieldA, there is a fieldB value which ranges from 0 to 130.

There is also a numberfield attached to each row item which is as shown in column D.

What I would like to do is: to insert for each state, after the last fieldB value i.e. 8034, 6 more fieldA values i.e. for state 1 after row 11529 in the attached spreadsheet, I would like to add in state1 fieldA 8035, fieldB 0-130, and for numberfield I would like to take a direct copy of the number fields for the previous 130 rows (e.g. using an autofill of the previous 130 rows).

I would thus like to add in 6 more fieldA values for each state (1 and 2) thus addining in fieldA from 8035 to 8040 and cycling through the other fields.

The macro should be designed to pick up as many states as there are in columnA and extend each accordingly based on the rules described above.

Could anyone please help with this - doing it manually is quite tedious?

thanks and regards,

[xluser2007]

file attached here.

[xluser2007]

Ok, I have written a macro, but it may not be the best way to go about this (in terms of readable more efficient code).

[vba]Sub MacroFinal()

' I would like the macro to figure out the number of states in the CSV from ColumnA
' may need to create an array to store these as they may not be correctly ordered e.g. 1,3 4,5 instead of 1,2,3,4,5.
'so we will require an array of states to loop through. in the above example the array wil be {1,3,4,5}.
'At the moment the user has to specify the first state and the last state.
firststate = 1

laststate = 2

For State = firststate To laststate

For n = 1 To 65536
If Cells(n, 1) = State And Cells(n, 2) = 8034 And Cells(n, 3) = 130 Then
lastrow = n
End If
Next n

For x = 1 To 6
For M = lastrow + 1 + 131 * (x - 1) To lastrow + 131 * (x - 1) + 131
Rows(M).Select
Selection.Insert Shift:=xlDown
Next M
Next x

For y = 1 To 6

P = 0
Q = Cells(lastrow + 131 * (y - 1), 2)
M = Cells(1 + lastrow + 131 * (y - 1), 4)

For l = lastrow + 1 + 131 * (y - 1) To lastrow + 131 + 131 * (y - 1)
Cells(l, 1) = State
Cells(l, 2) = Q + 1
Cells(l, 3) = P
Cells(l, 4) = Cells(l - 131, 4)
P = P + 1
Next l

Next y

Next State

End Sub[/vba]
This works just fine and if you apply it to the original TypeA.csv in post#2, you will get the output as attached below (see next post).

Could anyone please help modify the above code, so that the macro will pick up and store the states in an array rather than get the user to input these into the macro (or anywhere else e.g. inputbox).


Also is there a way to use the range object to clean the above code up, and using resize and autofill I'm sure would make it slicker. I would really like to see how to do this using these methods rather than the Cells object method that I'm using, which makes it harder to read.

Could anyone please help improve on the above code. Any help appreciated.

Thanks,

[xluser2007]

Sample output from previous macro is attached here.

[xluser2007]

Anyone got any suggestions on how to better structure the code?

[xluser2007]

just bumping this once more.

Could any experts help me improve my coding for the above macro and make it more genralised in terms of issues raised in my earlier posts?

I would really, as always appreciate any help you can offer me .

[Krishna Kumar]

Hi,

[vba]Sub kTest()
Dim a, w(), i As Long, n As Long, j As Long, 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) = Val(a(i - 1, 2)) + c
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[/vba]
HTH

[xluser2007]

Krishna, many thanks for your superb code. I knew there would be a nicer way of doing this.

One query though. In this case, note that for each state the end values for each fieldA are 8034. Your macr (correctly) starts adding in 8035, 8036 ... 8040 after this and does the job.

However if i rerun the macro again (by accident for example). It will start adding in 8041, 8042 ..8046 etc. Thus in my original macro I had the line

[VBA]If Cells(n, 1) = State And Cells(n, 2) = 8034 And Cells(n, 3) = 130 Then [/VBA]

to check that we are only extending after 8034.

How can this sort of check be implemented in your code?

Thanks again.

[Krishna Kumar]

Hi,

Krishna, many thanks for your superb code

You are very welcome!

to check that we are only extending after 8034.

How can this sort of check be implemented in your code?

change

[vba]w(n, 2) = Val(a(i - 1, 2)) + c[/vba]

to

[vba]w(n, 2) = 8034 + c[/vba]

HTH

[xluser2007]

Hi Krishna,

many thanks for your help.

Sorry I Couldn't get back to you earlier, I had limited access to the internet in the last few days.

Here is your full, code with the above stated amendments.

[vba]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[/vba]

It works really well, except the change from:

[vba]w(n, 2) = Val(a(i - 1, 2)) + c[/vba]
to

[vba]8034 + c[/vba]
Doesn't quite address the problem of doing only one insertion of fieldA values 8035-8040 for each state.

For example if you run the above code multiple times on the original csv, then it will keep adding fieldA 8035-8040 continuously, as many times as you run the macro on the file.

Is there a way around it so that it will just allow one (single) run effectively per state?

Thanks for your help on this, I really appreciate it .

regards,

[Krishna Kumar]

Hi,

[vba]Sub kTest()
Dim a, w(), i As Long, n As Long, j As Long, Flg As Boolean
Dim StatWS As Worksheet, Ans
Application.ScreenUpdating = 0
On Error Resume Next
Set StatWS = Sheets("StatWS")
On Error GoTo 0
If StatWS Is Nothing Then
Set StatWS = Sheets.Add
StatWS.Name = "StatWS"
StatWS.Visible = xlSheetVeryHidden
End If
If StatWS.Cells(1, 1) = 1 Then
Ans = MsgBox("You can't run this program multiple times" & vbCrLf & _
"Do you want to run again?", vbYesNo, "Confirm")
If Ans = vbYes Then
StartHere:
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
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
StatWS.Cells(1, 1) = 1
End If
Else
GoTo StartHere
End If
Finish:
Set StatWS = Nothing
Application.ScreenUpdating = 1
End Sub[/vba]

[xluser2007]

Thanks for your kind help Krishna - very clever with a hidden sheet to check how many times the macro was run.

I will mark this Solved, but will keep you posted if I have further queries.

regards,

[xluser2007]

Hi Krishna,

I have a slightly variation to the original CSV extending problem.

In this case we have the similar 4 columns as inputs (please see CSV_Extending_Input_prob2.zip).

I have attached the target output (CSV_Extending_TARGET_Output_prob2.zip) and highlighted the relevant change to make to the input file.

This time we only need to insert 6 rows in column B for each state in column A.

In column C, it is slightly tricky, once we extend the 6 rows, we need to set the last row to be 0 and then reverse up incrementing by 1 till we hit 93 (as shown in the TARGET output spreadsheet).

Column D is easy, all values should be set to 0.

If you could please help with this I would really appreciate it, the back filling it what is tricky in column C for me.

regards,

[xluser2007]

BTW, this almost works Krishna,

[vba]Option Explicit
Option Base 1

Sub ExtendCSV_nonIBNR()

Dim a, w(), i As Long, n As Long, j As Long, Flg As Boolean
Dim c As Long

Application.ScreenUpdating = False

a = Range("a1").CurrentRegion.Resize(, 4).Offset(1, 0)

If a(UBound(a, 1) - 1, 2) <> 8034 Then
ActiveWorkbook.Close savechanges:=False
Exit Sub
End If

ReDim w(1 To Rows.Count, 1 To 4)
n = 0

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
For c = 1 To 6

n = n + 1
w(n, 1) = a(i - 1, 1)
w(n, 2) = Val(a(i - 1, 2)) + c + 1 ' added in an extra "+1" term here

w(n, 3) = 50000 ' set to dummy value of 5000, how do I set the final value, for 8040, after extending, as 0
' and increment backwards by 1?

w(n, 4) = 0 ' We want to drag down zeroes for the 6 projected
' quarters that we extend for the number of claims variable
' How do we make all values in this column at the end of the macro equal to 0?

Next
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



[/vba]
But the bolded line is where it can't do the required task of renumbering backwards in column C, and also backfilling all of column D with 0's.

If you could please show how to amend the code to do this, I would be very grateful.

[xluser2007]

BTW for post #13, here is the CSV_Extending_Input_prob2.zip file.

[xluser2007]

Also for post #13, here is the CSV_Extending_TARGET_Output_prob2.zip file.

[Krishna Kumar]

Hi,

[vba]Option Explicit
Option Base 1
Sub ExtendCSV_nonIBNR()
Dim a, w(), i As Long, n As Long, j As Long, Flg As Boolean
Dim c As Long

Application.ScreenUpdating = False

a = Range("a1").CurrentRegion.Resize(, 4).Offset(1, 0)

'If a(UBound(a, 1) - 1, 2) <> 8034 Then
' ActiveWorkbook.Close savechanges:=False
' Exit Sub
'End If

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) + 6 'we add 6 here with col c value
w(n, 4) = 0 'make all zero 'a(i, 4)
If a(i, 1) <> a(i + 1, 1) Then
For c = 1 To 6
n = n + 1
w(n, 1) = a(i - 1, 1)
w(n, 2) = Val(a(i - 1, 2)) + c + 1 ' added in an extra "+1" term here
w(n, 3) = w(n - 1, 3) - 1
w(n, 4) = 0
Next
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
Application.ScreenUpdating = True
End Sub[/vba]

HTH

[xluser2007]

Krishna,

Many thanks once again for your great help and code.

I particularly liked how you set the 4th column to be 0's at the start of the extending process.

Also I really liked increasing the value of columnC by 6 at the start of the extending process and then back incrementing by 1, very elegant.

regards,