VBA need help here!

NewToVBAs · Apr 2, 2011

Hi MrExcel

my program doesnt seems to be working =(

here is what i need to do:
1) read off the raw data file (filename: RawData.xls)
2) produce the Date as the first column, and the prices of the 5 goods in respective subsequent columns
3) omit all the prices for a date if price info is missing for any of the 5 goods

my RawData file looks like this: 2 columns of Date and Good1Price, followed by 1 empty column, then 2 columns of Date and Good2Price, followed by 1 empty column, etc...

Date Good1Price Date Good2Price Date Good3Price Date Good4Price Date Good5Price

this is my program code:

Sub CopyData()
'copy dates from raw data to project file
'Workbooks.Open Filename:="C:\Users\User\Desktop\RawData.xls"
Dim MyInput As String
MyInput = InputBox("Please input the raw data location and filename. E.g. C:\Users\Desktop\RawData.xls", "Filename")
Workbooks.Open Filename:=MyInput

Dim x1(3000)
Dim x2(3000)
Dim x3(3000)
Dim x4(3000)
Dim x5(3000)

For k = 1 To 5000
m = Workbooks("RawData.xls").Sheets("Prices").Cells(k, 1)
k_1 = k_1 + 1
If m = 0 Then Exit For
Next

For k = 1 To 5000
m = Workbooks("RawData.xls").Sheets("Prices").Cells(k, 4)
k_2 = k_2 + 1
If m = 0 Then Exit For
Next

For k = 1 To 5000
m = Workbooks("RawData.xls").Sheets("Prices").Cells(k, 7)
k_3 = k_3 + 1
If m = 0 Then Exit For
Next

For k = 1 To 5000
m = Workbooks("RawData.xls").Sheets("Prices").Cells(k, 10)
k_4 = k_4 + 1
If m = 0 Then Exit For
Next

For k = 1 To 5000
m = Workbooks("RawData.xls").Sheets("Prices").Cells(k, 13)
k_5 = k_5 + 1
If m = 0 Then Exit For
Next

For i = 1 To k_1
x1(i - 1) = Cells(i, 2)
Next i

For j = 1 To k_1
For i = 1 To k_2
If Cells(j, 1) = Cells(i, 4) Then
x2(j - 1) = Cells(i, 5)
Exit For
Else: x2(j - 1) = 0
End If
Next i
Next j

For j = 1 To k_1
For i = 1 To k_3
If Cells(j, 1) = Cells(i, 7) Then
x3(j - 1) = Cells(i, 8)
Exit For
Else: x3(j - 1) = 0
End If
Next i
Next j

For j = 1 To k_1
For i = 1 To k_4
If Cells(j, 1) = Cells(i, 10) Then
x4(j - 1) = Cells(i, 11)
Exit For
Else: x4(j - 1) = 0
End If
Next i
Next j

For j = 1 To k_1
For i = 1 To k_5
If Cells(j, 1) = Cells(i, 13) Then
x5(j - 1) = Cells(i, 14)
Exit For
Else: x5(j - 1) = 0
End If
Next i
Next j

k = 0

For i = 0 To k_1
If x1(i) = 0 Or x2(i) = 0 Or x3(i) = 0 Or x4(i) = 0 Or x5(i) = 0 Then
Else
Cells(k + 1, 2) = x1(i)
Cells(k + 1, 3) = x2(i)
Cells(k + 1, 4) = x3(i)
Cells(k + 1, 5) = x4(i)
Cells(k + 1, 6) = x5(i)
k = k + 1
End If
Next i

Range(Cells(k + 1, 1), Cells(k + 2000, 14)).Clear
Range(Cells(1, 7), Cells(k + 2000, 14)).Clear
Range(Cells(1, 4), Cells(k + 2000, 4)).NumberFormat = "General"

Dim RangeRawDates As Range, RangeDates As Range
Set RangeRawDates = Workbooks("RawData.xls").Sheets("Prices").Range("A1:F5000")
Set RangeDates = Workbooks("Result.xls").Sheets("Prices").Range("A1:F5000")

RangeRawDates.Copy RangeDates

End Sub

Michael M · Apr 2, 2011

Also, make sure the spelling of the worksheet is Exact and correct.
No leading or trailling spaces.
Case of the word "Prices" should also be exactly the same

NewToVBAs · Apr 2, 2011

hi

it works now but there is a row of prices missing for the first date. here is an attached screenshot of the output. i have checked my data and all the prices are available for the first date.

http://img215.imageshack.us/i/latestoutput.png/

i have also jus realized i have not explained clearly that instead of omit all the prices for a certain date if any of the 5 goods prices are not stated, i should delete the affected dates also. may i know how should i go about editing the codes?

my sincere apologies for the unclear message!

thanks krishnakumar once again

Krishnakumar · Apr 2, 2011

Hi,

replace the last portion of code with the following

Code:

With Worksheets("Prices").Range("a1")'<<<=====Adjust the sheet name here
        i = .CurrentRegion.Rows.Count
        .Resize(i, 7).ClearContents
        .Resize(, 7).Value = [{"Date","Good1","Good2","Good3","Good4","Good5","Temp"}]
        .Offset(1).Resize(n, 7).Value = k
        With .Resize(n + 1, 7)
            .AutoFilter field:=7, Criteria1:="<>5"
            On Error Resume Next
            .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(12).Delete shift:=xlUp
            On Error GoTo 0
            .AutoFilter
        End With
        .Offset(, 6).Resize(n + 1).ClearContents
    End With

NewToVBAs · Apr 3, 2011

hi

okie i've got it and this program is working just well!

thanks alot to krishnakumar!!!

Krishnakumar · Apr 3, 2011

NewToVBAs said:
hi

okie i've got it and this program is working just well!

thanks alot to krishnakumar!!!

Thanks for the feedback.

VBA need help here!

NewToVBAs

New Member

Michael M

Well-known Member

Excel Facts

NewToVBAs

New Member

Krishnakumar

Well-known Member

NewToVBAs

New Member

Krishnakumar

Well-known Member

Similar threads

Forum statistics

Share this page

VBA need help here!

NewToVBAs

New Member

Michael M

Well-known Member

Excel Facts

NewToVBAs

New Member

Krishnakumar

Well-known Member

NewToVBAs

New Member

Krishnakumar

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock