PDA

View Full Version : fill in the value accoding the date



Yjmmay34
05-03-2010, 09:07 PM
Hi, all. I want to get the QuantitySum number from the "ReportSample" and put them in the "Template" file row 12. actualy this two file should be in the different workbook. But i only allowed to upload one file, so i put them in the same workbook. Thank you. Please check the attachment below. Any help would be appreciated!

rbrhodes
05-03-2010, 11:16 PM
1) Homework?

2) 'QuantitySum number' = Col C: 'no.' ?

3) Wk = Wk15 is not in Jan

4) May is not Qtr1, neither is Jume. and July <> Qtr2

et cetera...

Better example, better description... might get you some help

Sorry!

Yjmmay34
05-03-2010, 11:50 PM
hi, rbrhodes. thanks for your attention. Actually i want to attach two file here, but the system is not allowed me to do so. do you have any idea that can make me upload two files at same time? Thank you

mdmackillop
05-04-2010, 12:25 AM
Zip them

Yjmmay34
05-05-2010, 06:25 PM
Hi , Sir. Thank you for your attention.
Can you please help me with my program here..I attached them below. What am i doing is run the macro inside the "Antoka" file, and choose the CustomerForecastReport & ActualReport then insert the data to the Antoka excel file conditionally.
now the problem is when i run the report fisrt time everything is ok, but when the second report running, the CustomerDemand data jump to below of the Actual data, which is undesired. I thoght this might because i use the "RowCount "in "Sub aaa()", but i donnt know how should i modify it. I have to accumulate all forecast dataabove the actual data, and everytime the actual data should be just show the updated data(only one row below the Forecast data). So i think everytime i run the new report there should be one row insert above the Actual data, as i donot sure how many reports there are. Please see the "FinalProgramSample", this is what should be look like after running all report. Below is the calculation between these two data. I wrote my code inside the Antoka file, please open and choose report i attached. If anyproblem please ask i will reply as soon as possible. Any help would be greatly appreciated!!

rbrhodes
05-07-2010, 03:46 PM
Hi Yj,

Well there is a lot that should be done with your project. (Click on my name or sig to 'hire' me).

Having said that I did find the main problem and fixed it with an explanation of what it is in the attached. I also fixed/changed/edited a lot of other stuff...

-Caption on form 'Cancle' changed to 'Cancel'
-Changed 'Januray' in Sub Format to 'January'
-Deleted Sheets 2 & 3
-Added 'Option Explicit' to the Module and Dim'd all variables in the Subs (ALWAYS!)
-Changed 'SheetCount = 24' in Sub aaa to Sheetcount =Thisworkbook.Sheets.Count to avoid errors
-Moved messagebox from Macro1 to main and added 'ReRun?' and cleanup of Sheet1
-Added Screenupdating lines to Main for speed and flicker
-Added reset of Display alerts to Main
-Added vars 'fileext' as string and variant 'msg' to publics
-Added 'fileext to CustomerDemand Window Activate to avoid errors
-Changed Antoka.xls.xlsm to Antoka.xlsm in code (more errrors...)
-Added a temporary Testing button for rerunning code while developing and testing
-Added 'Cleanup' to set all Objects to Nothing when done (Public? and local vars)
-Added a temporary 'Kill' button to delete all sheets except sheet1 for developing and testing
('Testing' button runs Main and Kill button kils all results to try again...)

and finally added some code to aaa to fix your problem:


'find week
Set findit = SH.Range("B:B").Find(What:="Wk" & Right(ce.Value, Len(ce.Value) - 1) & ce.Offset(0, 5).Value)
If findit Is Nothing Then
If SH.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row < 4 Then
SH.Cells(4, 2).Value = "Wk" & Right(ce.Value, Len(ce.Value) - 1) & ce.Offset(0, 5).Value
Else
'//Added

'Original code was finding 'Actual' in row 12 and adding week below that
'this checks if row is 12 then if true, goes up from there to next blank row
'Note: Not all sheets have 'Actual entered in them but that's a different
'problem! and not part of this...

wkRow = SH.Cells(Rows.Count, 2).End(xlUp).Row
If wkRow = 12 Then
wkRow = SH.Cells(12, 2).End(xlUp).Row + 1
Else
wkRow = SH.Cells(Rows.Count, 2).End(xlUp).Row + 1
End If
SH.Cells(wkRow, 2).Value = "Wk" & Right(ce.Value, Len(ce.Value) - 1) & ce.Offset(0, 5).Value

'//End



BTW:
-Not all sheets are having 'Actual' entered in them...
-Selecting and activating is generally not needed and slows down the execution
-You should use 'With' for many of the repeated statements
-Vars should be declared, created and destroyed within their own subs I think
-Don't know if 'Actual' should always be row 12? what if more data added...
-Errorhandling would be good

-Bunch of other stuff...

But that's a few hours of my time for free. Good luck!

Aussiebear
05-08-2010, 03:20 PM
That's an excellent response to the OP. Generally speaking when asking for assistance in these forums, we normally expect single issue type threads. In this case because of the numerous issues found and corrected, DR has gone overboard (in the nicest way) in the help provided. A big round of thanks from the staff here at VBA Express to you DR.:friends:

rbrhodes
05-08-2010, 03:24 PM
Cheers!

Yjmmay34
05-09-2010, 07:05 PM
Hello, rbrhodes. Sorry for the delay of replying. Firstly, thank you so much for spending your valuable time to edit the program. The macro can run perfectly. And it save me a lot of time. But just like what you said at last part"Don't know if 'Actual' should always be row 12? what if more data added..." the 'Actual" shouldn't always be row12, it should insert one new row everytime i run the ActualReport, is it possible?
And you said i should"(Click on my name or sig to 'hire' me)." What's this means? how should i 'hire' you?? Thank you!

rbrhodes
05-09-2010, 11:08 PM
Hi Yj,

Your Macro1 was always putting 'Actual' in row 12. Replace Macro1 with this one. It will look at the rows, first time putting 'Actual' in row 12 then after that it will insert a row for every week added:


Sub Macro1()

Dim aRow As Long
Dim wRow As Long
Dim OldSht As String

myMonths = "jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec"

Set meWb = ThisWorkbook

'open Actual Report file
'Set actRepWb = Workbooks.Open(fileToOpen)
Set actRepWb = Workbooks.Open(ActualShippingReport)
Set actRepSh = actRepWb.ActiveSheet

Application.WindowState = xlNormal
With Columns("B")
.Replace What:=", INC.", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Replace What:=" LTD.", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End With

'get last row of Actual Report
lastRow = actRepSh.Cells(Rows.Count, "b").End(xlUp).Row
'for each row in Actual Report
For r = 1 To lastRow
If Trim(actRepSh.Cells(r, "b")) <> "" _
And Not LCase(actRepSh.Cells(r, "b")) Like "*group*customer*name" Then
'get group, geomtry and other info from Actual Report
myGroup = actRepSh.Cells(r, "b")
myGeometry = actRepSh.Cells(r, "c")
myYear = actRepSh.Cells(r, "e")
myMonth = actRepSh.Cells(r, "g")
myMonthNum = InStr(myMonths, LCase(myMonth)) \ 4 + 1
myQty = actRepSh.Cells(r, "h")
myShName = myGroup & myGeometry
'Test if SampleTemplate has sheet named according to group and geometry
OldSht = mySheet
mySheet = ""
On Error Resume Next
my Sheet = meWb.Sheets(myShName).Name
On Error GoTo 0
'if sheet exists in SampleTemplate
If mySheet <> "" Then
Set meSh = meWb.Sheets(myShName)
lastCol = meSh.Cells(3, Columns.Count).End(xlToLeft).Column
'scroll all data in row 3 to find correct month/year
With meSh
If OldSht = myShName Then GoTo nextsht
aRow = .Range("B" & Rows.Count).End(xlUp).Row
If aRow < 12 Then
aRow = 12
ElseIf aRow = 12 Then
'Get weeks row
wRow = .Cells(aRow, 2).End(xlUp).Row
If wRow > 4 Then
'Insert a row
.Cells(aRow, 1).EntireRow.Insert
aRow = aRow + 1
End If
Else
'Insert a row
.Cells(aRow, 1).EntireRow.Insert
aRow = aRow + 1
End If
'//End
nextsht:
For c = 3 To lastCol
If Month(.Cells(3, c)) = myMonthNum And Year(.Cells(3, c)) = myYear Then
.Cells(aRow, c) = myQty
.Cells(aRow, 2) = "Actual"
Exit For
End If
Next c
End With
End If
End If
Next r

actRepWb.Close False

'//Added
With Sheet1
.Rows(2).EntireRow.Delete
.Range("A1").Select
End With
'//End
'//Moved msg to Main
End Sub


By Hire me I mean that allthough the subs will run as is they could use a lot of work to make them faster, more efficient and more solid and dependable. I'm not willing to do all of that work for free so you could offer to pay me to do it all and support the project.

On the other hand you can use them as they are or you may even be able to find someone willing to clean it all up for free

Yjmmay34
05-09-2010, 11:32 PM
Hi, rbrhodes. I could understand and it's absolutely fair to pay for your excellent working. But i am just a foreign student study overseas. I do appreciated your kindly help. I will try to understand your code and is it possible to ask for further question??

Yjmmay34
05-10-2010, 07:22 PM
Hi, rbrhodes. The macro run first two report everything working well. But when i run the third report, the customer demand data jump to the wrong row again which is in the same row just behind the actual data. and the previous actual data still remain there havent delete by itself. please help me. Thank you!

rbrhodes
05-10-2010, 09:58 PM
Hi YJ,


[EDIT]

I only have your 2 sample reports to work with so I thought I had solved it. Perhaps send me 1 or 2 more reports to test with.

[END]

Forget the above. I faked a third report and found the problem It was in my original solution. Replace your sub 'aaa' with this one or replace the 2 lines I marked here:


Sub aaa()

'//Added
Dim WB As Workbook
Dim SH As Worksheet
Dim ce As Range
Dim findit As Range
Dim outcol As Long
Dim outrow As Long
Dim wkRow As Long
'//End
Set WB = ThisWorkbook
TotalColCount = ActiveSheet.UsedRange.Columns.Count

For Each ce In Range("D4:D" & Cells(Rows.Count, "D").End(xlUp).Row)

On Error Resume Next
Set SH = Nothing
Set SH = WB.Sheets(ce.Offset(0, -2).Value & ce.Offset(0, -1).Value)
On Error GoTo 0

'Get sheet name accoding to the GroupCustomer and geometry
If SH Is Nothing Then
WB.Sheets.Add before:=Sheets(1)
WB.Sheets(1).Name = ce.Offset(0, -2).Value & ce.Offset(0, -1).Value
Windows("Antoka 1.xlsm").Activate
Set SH = WB.Sheets(ce.Offset(0, -2).Value & ce.Offset(0, -1).Value)
End If
'find week
Set findit = SH.Range("B:B").Find(What:="Wk" & Right(ce.Value, Len(ce.Value) - 1) & ce.Offset(0, 5).Value)
If findit Is Nothing Then
If SH.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row < 4 Then
SH.Cells(4, 2).Value = "Wk" & Right(ce.Value, Len(ce.Value) - 1) & ce.Offset(0, 5).Value
Else
'//Added
wkRow = SH.Cells(Rows.Count, 2).End(xlUp).Row

'***************HERE***************************

'//Changed from = 12 to >=12
'OLD: If wkRow = 12 Then
If wkRow >= 12 Then
'//End

'//Changed from SH.Cells(12,2) to SH.Cells(wkrow,2)
'OLD: wkRow = SH.Cells(12, 2).End(xlUp).Row + 1
wkRow = SH.Cells(wkRow, 2).End(xlUp).Row + 1
'//End

'************TO HERE***************************

Else
wkRow = SH.Cells(Rows.Count, 2).End(xlUp).Row + 1
End If
SH.Cells(wkRow, 2).Value = "Wk" & Right(ce.Value, Len(ce.Value) - 1) & ce.Offset(0, 5).Value
'//End
End If
Set findit = SH.Range("B:B").Find(What:="Wk" & Right(ce.Value, Len(ce.Value) - 1) & ce.Offset(0, 5).Value)
End If

outrow = findit.Row
Columns("A:ZZ").EntireColumn.AutoFit
'find date
Set findit = SH.Rows("3:3").Find(What:=DateValue("" & ce.Offset(0, 3).Value & "/" & ce.Offset(0, 1).Value), LookIn:=xlFormulas)
If findit Is Nothing Then
If SH.Cells(3, Columns.Count).End(xlToLeft).Offset(0, 1).Column < 3 Then
SH.Cells(3, 3).Value = DateValue("" & ce.Offset(0, 3).Value & "/" & ce.Offset(0, 1).Value)
Else
SH.Cells(3, Columns.Count).End(xlToLeft).Offset(0, 1).Value = DateValue("" & ce.Offset(0, 3).Value & "/" & ce.Offset(0, 1).Value)
End If
Set findit = SH.Rows("3:3").Find(What:=DateValue("" & ce.Offset(0, 3).Value & "/" & ce.Offset(0, 1).Value))
End If

Columns("A:ZZ").EntireColumn.AutoFit
outcol = findit.Column

SH.Cells(outrow, outcol).Value = ce.Offset(0, 4).Value

Next ce
'formating the sheet
Windows("Antoka 1.xlsm").Activate
'//Changed
'SheetCount = 24
SheetCount = ActiveWorkbook.Sheets.Count
'//End
SheetNum = 1
i = 1
TotalColCount = ActiveSheet.UsedRange.Columns.Count
Do While i <= SheetCount

Windows("Antoka 1.xlsm").Activate
Sheets(i).Select
Range("B2").Value = "Customer/Geometry"
Range("B2").Select
With Selection.Font
.Name = "Arial"
.Size = 14
End With

Range(Cells(2, 2), Cells(2, TotalColCount)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range(Cells(3, 3), Cells(3, TotalColCount)).Select
Selection.NumberFormat = "mmm-yyyy"
i = i + 1
nextsheet:
Loop

TotalColCount = 1
'//Deleted
'Windows(CustomerDemand & fileext).Activate
'//End
Windows(CustomerDemand & fileext).Close

'//Added
Set WB = Nothing
Set SH = Nothing
Set ce = Nothing
Set findit = Nothing
'//End
End Sub

Yjmmay34
05-10-2010, 10:54 PM
Thank you Sir. Greatly appreciated your help. And is it possible to do the calculation between these two group of data? i mean all the customer forecast data and actual data. just like the sample program that i attached last time. does macro can automatically calculate the inaccuracy numbers{formula: (actual-forecast)/forecast }
Thank you!

rbrhodes
05-11-2010, 03:59 PM
and this formula ends up below 'Actual' I take it..?

1) Rename your 'Macro1' so you don't have a duplicate

2) Copy this 'Macro1' into the file and run the reports

3) If it works it's yours if it doesn't work, delete it and rename your original Macro1 back to Macro1

Note: This is becoming a project...

Someone is benefiting from this. If you are a working student then whoever you are working for is benefiting from this and they should pay for it.

Sorry but I just came on board to answer the original question and I think I'm outta time.


Sub Macro1()

Dim aRow As Long
Dim wRow As Long
Dim OldSht As String

myMonths = "jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec"

Set meWb = ThisWorkbook

'open Actual Report file
'Set actRepWb = Workbooks.Open(fileToOpen)
Set actRepWb = Workbooks.Open(ActualShippingReport)
Set actRepSh = actRepWb.ActiveSheet

Application.WindowState = xlNormal
With Columns("B")
.Replace What:=", INC.", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Replace What:=" LTD.", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End With

'get last row of Actual Report
lastRow = actRepSh.Cells(Rows.Count, "b").End(xlUp).Row
'for each row in Actual Report
For r = 1 To lastRow
If Trim(actRepSh.Cells(r, "b")) <> "" _
And Not LCase(actRepSh.Cells(r, "b")) Like "*group*customer*name" Then
'get group, geomtry and other info from Actual Report
myGroup = actRepSh.Cells(r, "b")
myGeometry = actRepSh.Cells(r, "c")
myYear = actRepSh.Cells(r, "e")
myMonth = actRepSh.Cells(r, "g")
myMonthNum = InStr(myMonths, LCase(myMonth)) \ 4 + 1
myQty = actRepSh.Cells(r, "h")
myShName = myGroup & myGeometry
'Test if SampleTemplate has sheet named according to group and geometry
OldSht = mySheet
mySheet = ""
On Error Resume Next
mySheet = meWb.Sheets(myShName).Name
On Error GoTo 0
'if sheet exists in SampleTemplate
If mySheet <> "" Then
Set meSh = meWb.Sheets(myShName)
lastCol = meSh.Cells(3, Columns.Count).End(xlToLeft).Column
'scroll all data in row 3 to find correct month/year
With meSh
If OldSht = myShName Then GoTo nextsht
aRow = .Range("B" & Rows.Count).End(xlUp).Row
If aRow < 12 Then
aRow = 12
'//Added
wRow = 4
'//End
ElseIf aRow = 12 Then
'Get weeks row
wRow = .Cells(aRow, 2).End(xlUp).Row
If wRow > 4 Then
'Insert a row
.Cells(aRow, 1).EntireRow.Insert
aRow = aRow + 1
End If
Else
'//Added
'Get weeks row
wRow = .Cells(aRow, 2).End(xlUp).Row
'//End
'Insert a row
.Cells(aRow, 1).EntireRow.Insert
aRow = aRow + 1
End If
nextsht:
For c = 3 To lastCol
If Month(.Cells(3, c)) = myMonthNum And Year(.Cells(3, c)) = myYear Then
.Cells(aRow, c) = myQty
.Cells(aRow, 2) = "Actual"
'//Added
.Cells(aRow + 1, c) = "=IF(" & Cells(wRow, c).Address & "<>0,(" & Cells(aRow, c).Address & "-" & Cells(wRow, c).Address & ")/" & Cells(wRow, c).Address & ",1)"
.Cells(aRow + 1, c).NumberFormat = "0.00%"
'//End
Exit For
End If
Next c
End With
End If
End If
Next r

actRepWb.Close False

With Sheet1
.Rows(2).EntireRow.Delete
.Range("A1").Select
End With
End Sub

Yjmmay34
05-11-2010, 07:36 PM
Thank you Sir, this is my final year of study in school. And i am doing one of my project in a comapny. And they assigned me to do this program but i am a vba beginner, never learn this before. That's why i post thread here. And thanks a lot that you spent so many time to help without any complain.
But will you to help me the last time to accumulate all the calculation results instead of only show the updated one??
Thank you Sir.