PDA

View Full Version : VBA Code to copy required data into Separate Sheet



krishhi
06-11-2012, 07:04 PM
Hi Friends,

Good Day,

Every month I am downloading a CSV file from a Website. I would like to copy only some portion from it.

Please see the attached file, so you guys can easily understand What I wanted.

Please let me know, if you have any doubts.

I tried myself, but I am struck at somewhere. Please help me on this one. :)

Waiting for your kind reply,

Best Regards,
krrish

Tinbendr
06-12-2012, 04:38 AM
Try this
Sub ParseFile()

Dim WS As Worksheet
Dim LR As Long
Dim aCell As Range
Dim A As Long

Set WS = Worksheets(1)

A = 1

With WS
LR = .Cells(.Rows.Count, "A").End(xlUp).Row

For Each aCell In .Range("A5:A" & LR)

If aCell <> "" Then
If aCell.Offset(, 1) = "" Then
With WS.Range("E" & aCell.Row & ":E" & LR)
Set Rng = .Find(what:="Tree Totals", LookIn:=xlValues, lookat:=xlPart)
If Not Rng Is Nothing Then

With Worksheets("Sheet1")
A = A + 1
.Range("A" & A).Value = aCell.Value
.Range("B" & A).Value = Rng.Offset(, 1).Value
.Range("C" & A).Value = Rng.Offset(, 1).Value
.Range("D" & A).Value = Rng.Offset(, 1).Value
.Range("E" & A).Value = Rng.Offset(, 1).Value
End With
End If
End With
End If
End If
Next
End With
End Sub

krishhi
06-12-2012, 09:05 AM
Hi Thanks for the reply. I tried the Code, but it copies the first value to the rest of the columns and same with other products.

Tinbendr
06-12-2012, 09:25 AM
Oops,
Change these lines.


.Range("C" & A).Value = Rng.Offset(, 2).Value
.Range("D" & A).Value = Rng.Offset(, 4).Value
.Range("E" & A).Value = Rng.Offset(, 5).Value

CodeNinja
06-12-2012, 09:37 AM
I think this would work for you... if you hide column d when done... sorry, but I was being a bit lazy with the copy/pastes :)


Sub test()

Dim iCount As Integer
Dim rng As Range
Dim rng2 As Range
Dim rngAfter As Range


' header:
Sheet2.Cells(1, 1) = "Product"
Sheet1.Range("F5:J5").Copy
Sheet2.Range("B1:F1").PasteSpecial
Sheet2.Cells(2, 1) = Sheet1.Cells(6, 1)

' data
Set rng = Sheet1.Range("E1:E" & Sheet1.Range("E65536").End(xlUp).Row)
Set rngAfter = rng.Cells(rng.Cells.Count)
For iCount = 1 To WorksheetFunction.CountIf(rng, "Tree Totals:")
Set rng2 = rng.Find(what:="Tree Totals:", lookat:=xlWhole, after:=rngAfter)
Set rngAfter = rng2
Set rng2 = Sheet1.Range("F" & rngAfter.Row & ":J" & rngAfter.Row)
rng2.Copy
Sheet2.Activate
Sheet2.Range("B" & iCount + 1 & ":F" & iCount + 1).Select
Selection.PasteSpecial
Sheet2.Cells(iCount + 2, 1) = Sheet1.Cells(rngAfter.Row + 1, 1)
Next iCount


End Sub

krishhi
06-13-2012, 12:28 AM
Oops,
Change these lines.


.Range("C" & A).Value = Rng.Offset(, 2).Value
.Range("D" & A).Value = Rng.Offset(, 4).Value
.Range("E" & A).Value = Rng.Offset(, 5).Value


Thank you So much. :)

krishhi
06-13-2012, 12:30 AM
I think this would work for you... if you hide column d when done... sorry, but I was being a bit lazy with the copy/pastes :)


Sub test()

Dim iCount As Integer
Dim rng As Range
Dim rng2 As Range
Dim rngAfter As Range


' header:
Sheet2.Cells(1, 1) = "Product"
Sheet1.Range("F5:J5").Copy
Sheet2.Range("B1:F1").PasteSpecial
Sheet2.Cells(2, 1) = Sheet1.Cells(6, 1)

' data
Set rng = Sheet1.Range("E1:E" & Sheet1.Range("E65536").End(xlUp).Row)
Set rngAfter = rng.Cells(rng.Cells.Count)
For iCount = 1 To WorksheetFunction.CountIf(rng, "Tree Totals:")
Set rng2 = rng.Find(what:="Tree Totals:", lookat:=xlWhole, after:=rngAfter)
Set rngAfter = rng2
Set rng2 = Sheet1.Range("F" & rngAfter.Row & ":J" & rngAfter.Row)
rng2.Copy
Sheet2.Activate
Sheet2.Range("B" & iCount + 1 & ":F" & iCount + 1).Select
Selection.PasteSpecial
Sheet2.Cells(iCount + 2, 1) = Sheet1.Cells(rngAfter.Row + 1, 1)
Next iCount


End Sub


Super working.. Thank you so much.

Is it possible to grab the grand totall also at the end?

Once again thank you so much.

Tinbendr
06-13-2012, 04:12 AM
Add at the bottom.
With WS.Range("E1:E" & LR)
Set Rng = .Find(what:="Grand Totals", LookIn:=xlValues, lookat:=xlPart)
If Not Rng Is Nothing Then
With Worksheets("Sheet1")
A = A + 1
.Range("A" & A).Value = Rng.Value
.Range("B" & A).Value = Rng.Offset(, 1).Value
.Range("C" & A).Value = Rng.Offset(, 2).Value
.Range("D" & A).Value = Rng.Offset(, 4).Value
.Range("E" & A).Value = Rng.Offset(, 5).Value
End With
End If
End With

krishhi
06-13-2012, 04:57 AM
Add at the bottom.
With WS.Range("E1:E" & LR)
Set Rng = .Find(what:="Grand Totals", LookIn:=xlValues, lookat:=xlPart)
If Not Rng Is Nothing Then
With Worksheets("Sheet1")
A = A + 1
.Range("A" & A).Value = Rng.Value
.Range("B" & A).Value = Rng.Offset(, 1).Value
.Range("C" & A).Value = Rng.Offset(, 2).Value
.Range("D" & A).Value = Rng.Offset(, 4).Value
.Range("E" & A).Value = Rng.Offset(, 5).Value
End With
End If
End With

Wow.. Thank you so much. You guys saved my day :)