PDA

View Full Version : Fetch the data's from excel file and provide the CSV file as a output



laxmananm
10-24-2014, 07:26 AM
Dear Friends,

Please find attached the sample data, output file format and the format of the output file.
I have created names for all columns like P.APR, I.APR etc for all months.

In the output file, the first 2 column values are coming from the Config sheet and other from Data Sheet. In the Type column P,S,I,ADJ can be hard coded.
(I just put this as the column name in the sample excel)

The output file needs to get from the sample data excel
Format.xls is for the understanding of the output file. I mean from which column in Sample data.xls the value is picking.

Kind Regards,

laxmananm
10-24-2014, 12:16 PM
Dear masters,
Kindly help me to resolve my issue.waitting for the guru's valuable comments

Lax

Kenneth Hobs
10-24-2014, 08:19 PM
It is not that hard but will take a day or two before you get an answer I suspect. We have to figure out your logic. You have documented it relatively well but there are a few things that will take some brain cells to figure out. Several on the forum can figure it out. Just be patient is my advice. This kind of thing takes about 80% understanding of your format and goals and 20% coding to mirror the logic.

I figured out that the previous month for column W12 in the CSV file is this month - 1 month, the SEP data. From there, one gets that rows column data as you detailed. I'll have to study it a bit more tomorrow if no one helps you before then.

After DEC is reached, will roll to JAN on that same worksheet's year or the next worksheet's JAN?

Even when you get a solution, you will probably be back for some tweaks as your layout for the data might change I suspect.

laxmananm
10-25-2014, 12:04 AM
Dear Hobs,
Thanks for the response and thanks for the interest.
For your ques:yes we have to move next worksheet.
Waiting for your comments/help.

Kind regards,
Lax

Kenneth Hobs
10-31-2014, 12:33 PM
Hope this isn't too "scary".

Code can get a bit tricky and messy when one has to deal with merged cells. The adjust data column or field in database terminology was missing in the data file so that is why the output does not look the same for that data. I had to check for both types of month naming conventions since you used both.

I doubt this will handle every scenario but it might give you a start. I left a few more comments than usual to show you how to use Debug.Print to send a run's output to the Immediate window for debug purposes. A function or two is not needed nor are a few of the dimmed variables. I most always use Option Explicit.


Option Explicit

Sub Run_fOutput()
fOutput
End Sub


Sub fOutput()
Dim fn As Variant, fldr As String
Dim iHandle As Integer, s As String, a(1 To 26) As String
Dim i As Integer, j As Integer, iMon As Integer, sMon As String
Dim w(1 To 5) As String, cModels As Long, clModel As Long, lj As Long
Dim d As Date, d1 As Date
Dim r As Range, f As Range, catOff(1 To 5, 1 To 2) As String
Dim lCol As Integer, c As Range, mRange(1 To 11) As Range, v As Variant
Dim ii As Integer

fldr = ThisWorkbook.Path & "\"
fn = Application.GetSaveAsFilename(fldr & "ken.csv", "Text Files (*.csv), *.csv")
If fn = False Then Exit Sub

'Create field names
For i = 1 To 26
a(i) = "W" & i
Next i

'Write Model category abbreviations and column offests.
catOff(1, 1) = "PR"
catOff(1, 2) = 0
catOff(2, 1) = "IP"
catOff(2, 2) = 2
catOff(3, 1) = "SL"
catOff(3, 2) = 3
catOff(4, 1) = "AJ"
catOff(4, 2) = 7
catOff(5, 1) = "ST"
catOff(5, 2) = 4

'Create first 5 field values
w(1) = ""
w(2) = 3
With Worksheets("Config")
w(3) = .Range("B8").Value2
w(4) = .Range("B9").Value2
w(5) = .Range("B10").Value2
End With

'Number of models on sheet2
'cModels = Worksheets(2).Range("A5").End(xlDown).Row - 4
'Row number of last model on sheet2
clModel = Worksheets(2).Range("A5").End(xlDown).Row


'Make find string for first month name in "mmm" format.
iMon = Month(Date) - 1
sMon = Format(DateSerial(2014, iMon, 1), "mmm")

'Find range on sheet2 with sMon name.
With Worksheets(2)
'Sheet2 range to search for sMon name.
lCol = .Cells(3, Columns.Count).End(xlToLeft).Column
Set r = .Range("A3:" & ColumnLetter(lCol) & 3)
Set f = r.Find(sMon)
If f Is Nothing Then
sMon = Format(DateSerial(2014, iMon, 1), "mmmm")
Set f = r.Find(sMon)
End If
If f Is Nothing Then
MsgBox "Month could not be found on sheet2.", vbCritical, "Macro Ending"
Exit Sub
End If
Set r = .Range(f.Address & ":" & ColumnLetter(lCol) & 3)
End With

'Create mRange() for ranges of needed Months
i = 0
'All months on sheet2, Data
For Each c In r
If c.Value2 <> "" Then
i = i + 1
Set mRange(i) = c(1)
End If
Next c
'Add months, if needed, on sheet3, Data2
If i <> 11 Then
j = 0
For i = i + 1 To 11
With Worksheets(3)
Set mRange(i) = .Cells(3, 2 + j)
j = j + 8
End With
Next i
End If

'For Each v In mRange
'Debug.Print v.Address, v.Address(external:=True), v.Value, v.Worksheet.Name
'Next v


'Create the CSV fn file
iHandle = FreeFile
Open fn For Output Access Write As #iHandle

'Write field names
Print #iHandle, Join(a(), ",")

'Write first 5 field values
'Print #iHandle, Join(w(), ","); '";" does not add a vbCrLf character to record
'Print #iHandle, ",more stuff to do"

'Create and Write to file, a(), a full record with data

For lj = 5 To clModel 'Model row numbers
'Model types, lj
For j = 1 To 5
'Write first 5 field values to a()
For i = 1 To 5
a(i) = w(i)
Next i
'Model, W6
a(6) = Worksheets(2).Cells(lj, "A").Value2
a(7) = ""
a(8) = 0
a(9) = ""
'Model type's name
a(10) = catOff(j, 1)
a(11) = 0
'Get value for each model's type for the model category
For ii = 1 To 11
a(11 + ii) = mRange(ii).Offset(2 + lj - 5)(, 1 + catOff(j, 2)).Value
'Debug.Print mRange(ii).Offset(2 + lj - 5)(, 1 + catOff(j, 2)).Address(external:=True)
Next ii
a(23) = ""
a(24) = ""
a(25) = ""
a(26) = ""
Print #iHandle, Join(a(), ",")
Next j

Next lj

Close #iHandle


Shell "cmd /c notepad " & fn, vbNormal
End Sub


Function ColumnLetter(ColumnNum As Integer) As String
ColumnLetter = Split(Cells(1, ColumnNum).Address, "$")(1)
End Function


Function ColumnNumber(sColumnLetter As String) As Integer
ColumnNumber = Cells(1, sColumnLetter).Column
End Function


Function AppendToTXTFile(strFile As String, strData As String) As Boolean
Dim iHandle As Integer
iHandle = FreeFile
Open strFile For Append Access Write As #iHandle
Print #iHandle, strData
Close #iHandle
AppendToTXTFile = True
End Function

laxmananm
11-01-2014, 06:06 AM
Dear Hobs,

You are great.Such a awesome code..Thanks