EXCEL FEED: Re: [ExcelVBA] Re: Help required for a difficult macro

Selasa, 09 Desember 2014

Re: [ExcelVBA] Re: Help required for a difficult macro

Dear All

I have received following code but the problem is that i run these code more than 5000 rows, excel is hanged and going to not responding.

Sub Data_base()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

Dim rng2 As Range

Dim LRws1 As Long, LRws3 As Long

Dim chk As Variant

Dim match_formula As Variant

Set ws1 = Sheets("Fruit Data Base")

Set ws2 = Sheets("Fruit Order List")

Application.ScreenUpdating = False

ws1.Copy After:=Worksheets(Worksheets.Count)

Worksheets(Worksheets.Count).Name = "Helper_sheet"

Set ws3 = Sheets("Helper_sheet")

On Error Resume Next

LRws2 = ws2.UsedRange.Rows.Count

LRws3 = ws3.UsedRange.Rows.Count

Set rng2 = ws2.Range("D3:D" & LRws2)

For Each r In rng2

If r.Offset(, -1).Value = 0 Or r.Offset(, -1).Value = "-" Then

r.Value = "!"

For i = 1 To LRws3

If ws3.Range("A1").Offset(i).Value = r.Offset(, -2).Value And ws3.Range("A1").Offset(i, 3).Value = r.Offset(, 1).Value Then

r.Value = ws3.Range("A1").Offset(i, 2).Value

ws3.Range("A1").Offset(i, 2).EntireRow.Delete

GoTo Skip1

End If

Next i

End If

Skip1:

Next r

LRws3 = ws3.UsedRange.Rows.Count

For Each r In rng2

If r.Value = "!" Then

For i = 1 To LRws3

If ws3.Range("A1").Offset(i).Value = r.Offset(, -2).Value And ws3.Range("A1").Offset(i, 3).Value > r.Offset(, 1).Value Then

ws3.Range("A1").Offset(i, 4).Value = ws3.Range("A1").Offset(i, 3).Value - r.Offset(, 1).Value

End If

Next i

For i = 1 To LRws3

If WorksheetFunction.Max(ws3.Range("A1:A" & LRws3).Offset(, 4)) > 0 And ws3.Range("A1").Offset(i, 4).Value = WorksheetFunction.Min(ws3.Range("A1:A" & LRws3).Offset(, 4)) Then

r.Value = ws3.Range("A1").Offset(i, 2).Value

ws3.Range("A1").Offset(i, 3).Value = ws3.Range("A1").Offset(i, 4).Value

ws3.Range("A1:A" & LRws3).Offset(, 4).ClearContents

GoTo skip2

End If

Next i

End If

skip2:

Next r

Application.DisplayAlerts = False

ws3.Delete

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

On Monday, December 8, 2014 1:55 AM, ayaz khan <ayazthegreat2001@yahoo.com> wrote:

Further I explain it here again

There are 2 sheets one is sheet1 and another is result sheet

Sheet1 is a product database

Result sheet is a query or order sheet of product

By matching ID from result sheet to sheet1, You have to distribute EDI # from sheet1 to result sheet in col c on following conditions

1- where col b is blank or - or 0 value in result sheet

2 _ if above condition is met then distribute order (EDI # from sheet1 col b as to result sheet) as I mentioned in my test file in result sheet and check qty in sheet1 if order product qty less or equal

In less qty it goes to next matching ID qty if it is equal or greater then copy this EDI # from sheet1 col b to result sheet in col c

I have given example in my sent file in result sheet please go through it carefully

3 - if first matching qty v b p
Sent from Yahoo Mail on Android

From:"ayaz khan" <ayazthegreat2001@yahoo.com>
Date:Mon, 8 Dec, 2014 at 1:28 AM
Subject:Re: [ExcelVBA] Re: Help required for a difficult macro

Thanks David for your advice I explain my logic in my sent file as well you can see it if you have any confusion or query regarding to my sent file in required result in result sheet please do mention it and I must explain it clearly

Sent from Yahoo Mail on Android

From:"'david braithwaite' dbraithwaite@charter.net [ExcelVBA]" <ExcelVBA@yahoogroups.com>
Date:Mon, 8 Dec, 2014 at 1:14 AM
Subject:[ExcelVBA] Re: Help required for a difficult macro

Suggest that you write the logic required as if you were giving directions to another person who was going to do the process by hand.

Excel is just a tool for implementing such a process, but so is a pencil and paper. Write for the latter and get surprised by the elegant solution for the former.

Tim Lewis's posting MAY be such a solution.

-db-

__._,_.___

Posted by: ayaz khan <ayazthegreat2001@yahoo.com>

Reply via web post

•

Reply to sender

•

Reply to group

•

Start a New Topic

•

Messages in this topic (21)

----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------

Visit Your Group