Reformating Report with Macro

**anticedant** · 11-03-2010, 09:01 AM

I am fairly new to programming macros and have a situation that is beyond what I normally create - any help would be greatly appreciated.

I have a stock report from our company's ERP that needs to be qualified and reformatted based on certain criteria. I have attached a sample for clarification.

Sheet1 shows what the report looks like after I run a preliminary scrubbing macro to remove blank rows and rows that are of no value. I've highlighted the information that I would like posted to a seperate sheet in the new format.

Here is the part that I'm struggling with...

The first couple records (marked on the file in red) have a List price value of 0 and therefore do no have a discounted price. I need the highlighted red cells of these records copied to a seperate sheet so we can go back and apply pricing to them later on - I've illustrated this on Sheet3.

The next four records (marked on the file in green) have some List price value and only a single discounted price. I need the highlighted green cells of these records copied to a seperate sheet in the appropriate columns, which I've shown on Sheet2.

Lastly, the next four records (marked on the file in blue) have some List price value and multiple discounted prices based on certain quantity breaks. I need the highlighted blue cells copied to the same sheet as mentioned in the previous paragraph (Sheet2), each cell in the appropriate columns.

As you can see from the raw data in Sheet1, the record types tend to be mixed. Also, the record types that have quantity discounts don't always have the same quantity breaks or even the same number of breaks. I need to somehow have a macro recognize these different record types as it runs through the file and take the appropriate action.

Can anyone help?

**JBeaucaire** · 11-03-2010, 12:25 PM

Try this out:

Option Explicit

Sub ParsePricingData()
'Author:    Jerry Beaucaire, ExcelForum.com
'Date:      11/3/2010
Dim Sh1 As Worksheet:   Set Sh1 = Sheets("Sheet1")  'the raw data sheet
Dim Sh2 As Worksheet:   Set Sh2 = Sheets("Sheet2")  'the good pricing sheet
Dim Sh3 As Worksheet:   Set Sh3 = Sheets("Sheet3")  'the bad pricing sheet
Dim Stocks As Range:    Set Stocks = Sh1.Range("A:A").SpecialCells(xlConstants)
Dim Stk As Range
Dim NR As Long, Rw As Long, LR As Long, C As Long

LR = Sh1.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Application.ScreenUpdating = False

    For Each Stk In Stocks
        If Stk.Value <> "Stock code :" Then GoTo NextStk
        If Left(Sh1.Range("R" & Stk.Row), 14) = "List price: 0." Then
            With Sh3
                NR = .Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & NR).Value = Sh1.Range("B" & Stk.Row).Value
                .Range("B" & NR).Value = Sh1.Range("B" & Stk.Row + 1).Value
                .Range("C" & NR).Value = Sh1.Range("R" & Stk.Row).Value
            End With
        Else
            With Sh2
                NR = .Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & NR).Value = Sh1.Range("B" & Stk.Row).Value
                .Range("B" & NR).Value = Sh1.Range("B" & Stk.Row + 1).Value
                .Range("C" & NR).Value = Sh1.Range("R" & Stk.Row).Value
                Rw = Stk.Row + 4
                Do
                    If IsNumeric(Sh1.Range("H" & Rw)) And Sh1.Range("R" & Rw) <> 0 Then _
                        Sh1.Range("H" & Rw & ",R" & Rw).Copy _
                            Sh2.Cells(NR, Columns.Count).End(xlToLeft).Offset(, 1)
                    Rw = Rw + 1
                    If Rw > LR Then Exit Do
                Loop Until Sh1.Cells(Rw, "A") <> ""
            End With
        End If
        
NextStk: Next Stk

With Sh2
    For C = 5 To .Cells(1, .Columns.Count).End(xlToLeft).Column Step 2
        .Columns(C).NumberFormat = "0.00"
    Next C
    .UsedRange.Font.Size = 8
    .UsedRange.Font.Name = "Arial"
    .UsedRange.Interior.ColorIndex = xlNone
End With

Application.ScreenUpdating = True
End Sub

**anticedant** · 11-03-2010, 01:18 PM

JBeaucaire,

I've ran your script against a couple different reports and so far everything looks great - I can't thank you enough for your help. I will post back if anything happens to go awry.

I truely appreciate all the experts that devote their time to help within this forum, as it speaks volumes about the quality of the community here. Again, thank you for the help JBeaucaire and anyone who attempted a solution.