Insert sheets from dump datas with more settings

[PRADEEPB270]

Please refer my attach file.

In this attachment,I want following solutions through VBA codes:-

1-Convert the 'Dump' sheet as a 'MC.9' sheet.
2-Insert the multiple sheets according to 'Storage Location' ( Col.D on MC.9 sheet ) e.g.'EA01','FA01' etc.
3-Print all the sheets,location wise on A4 size paper ( each location,one paper each ) except 'Dump' and 'MC.9' on 'A4' size paper up to 40 rows on a paper and above 40 it should print on a back side of the paper.For an instance,suppose sheet 'FA01, having 90 rows,then,print on A4 size paper as first 40 on front side ,next 40 back side of the front and rest next paper of A4 size.Similar to sheet 'EA01' having 30 rows,then,print on next page.

Can it be possible through VBA codes?

[HansV]

Please describe clearly and in detail how Dump should be converted to MC.9.

[PRADEEPB270]

Column A of 'Dump' sheet is the column B and C (separated with 'Material' and 'Material Description') of MC.9 sheet and column B of 'Dump' sheet is the column D and E ( separated with Storage Location and Description-Storage Location ) of MC.9 sheet.And next from Col.D=Col.F,Col.C=Col.G and Col.E=Col.H of the MC.9 sheet from Dump sheet.In my attach file,there will be only one sheet at start.Thereafter,insert a new sheet namely,MC.9 from Dump sheet.And from 'MC.9' sheet,Column 'D' will be extrapolated in the multiple sheets like EA01,FA01,M001 etc.

[HansV]

But the values of column B of the Dump sheet start with HHHD. I don't see that in the MC.9 sheet. So you must tell me EXACTLY how to separate the descriptions.
And there are rows where column B contains only HHHD. Sometimes, columns C to F contain non-zero numbers in those rows. What should happen with those rows?

[PRADEEPB270]

Now,please refer the revised attach file.

In this file,I have removed 'HHHD'.The other step is if col.'C and 'E'' have value less than '0' ( zero ) or equal to zero,then,the entire rows should not be appear in sheet 'MC.9'.

[HansV]

And if the values are equal to zero?

[PRADEEPB270]

It should not to be appear on MC.9 sheet.

[HansV]

In row 10 and in row 65 of the Dump sheet, there is no Storage location, but the numbers in columns C and E are not 0.
How should we treat these rows?

[PRADEEPB270]

Please take the following 2 procedures on 'Dump' sheet:-
1-If col.B have no Storage location,then,the entire row should not appear on MC.9 sheet.
2-If col.C have value less than 0 ( Zero ) or equal to 0 ( Zero ) then the entire row should not appear on MC.9 sheet whether the storage location appear in Col.B.

[HansV]

Next time, please provide this information at the start, instead of me having to ask so many questions.

The following macro will create the MC.9 sheet:

Code: Select all

Sub CreateMC9()
    Dim wshD As Worksheet
    Dim wshM As Worksheet
    Dim wsh As Worksheet
    Dim r As Long
    Dim m As Long
    Dim t As Long
    Dim strMaterial As String
    Dim strLocation As String
    Dim p As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wshD = Worksheets("Dump")
    wshD.UsedRange.Sort Key1:=wshD.Range("B1"), Key2:=wshD.Range("A1"), Header:=xlYes
    For Each wsh In Worksheets
        If wsh.Name <> "Dump" Then
            wsh.Delete
        End If
    Next wsh
    Set wshM = Worksheets.Add(After:=wshD)
    wshM.Name = "MC.9"
    wshM.Cells(1, 1).Value = "Material"
    wshM.Cells(1, 2).Value = "Material Description"
    wshM.Cells(1, 3).Value = "Storage Location"
    wshM.Cells(1, 4).Value = "Description-Storage Location"
    wshM.Cells(1, 5).Value = "Unit"
    wshM.Cells(1, 6).Value = "Book Bal."
    wshM.Cells(1, 7).Value = "Amount"
    m = wshD.Cells(1, 1).End(xlDown).Row
    For r = m To 2 Step -1
        If wshD.Cells(r, 2).Value = "" Or wshD.Cells(r, 3).Value = 0 Then
            wshD.Cells(r, 1).EntireRow.Delete
        End If
    Next r
    t = 1
    m = wshD.Cells(1, 1).End(xlDown).Row
    For r = 2 To m
        t = t + 1
        strMaterial = wshD.Cells(r, 1).Value
        p = InStr(strMaterial, " ")
        wshM.Cells(t, 1).Value = Left(strMaterial, p - 1)
        wshM.Cells(t, 2).Value = Trim(Mid(strMaterial, p))
        strLocation = wshD.Cells(r, 2).Value
        p = InStr(strLocation, " ")
        wshM.Cells(t, 3).Value = Left(strLocation, p - 1)
        wshM.Cells(t, 4).Value = Trim(Mid(strLocation, p))
        wshM.Cells(t, 5).Value = wshD.Cells(r, 4).Value
        wshM.Cells(t, 6).Value = wshD.Cells(r, 3).Value
        wshM.Cells(t, 7).Value = wshD.Cells(r, 5).Value
    Next r
    wshM.Range("G2:G" & t).NumberFormat = "#,##0.00"
    With wshM.Range("A1:G1")
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
        .EntireColumn.AutoFit
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

You can then use code similar to that in the thread Insert multiple sheets after convert raw sheets into main to create the individual sheets for EA01, FA01 etc.

[PRADEEPB270]

Hi Hansv,

Please look my attach file after your posting the macro.The MC.9 sheet have created but some problems are coming to create storage location wise sheets.I have paste the other macro for creation the sheets.But not working well.Will you please look what is missing steps by me?

[HansV]

The setup of your current workbook is not exactly the same as that of the one from the other thread, so you can't just copy the code and change the name of the sheets. You must also look at the name and position of the relevant columns. For example, in the other workbook, sloc was in column F, but in the MC.9 sheet, Storage Location is in column C. You have to look carefully what the code does and how the MC.9 sheet is different from the sheet in the other workbook.

And you don't have to create MC.9 again, that is already done by the macro in my previous reply.

[PRADEEPB270]

Hansv sir,

Can you please write the revised macro who create the workbook according to 'Storage location'of sheet MC.9? It is my humble request to you.Perhaps,I can't complete the last step.Now-a days,I am learning VBA concepts gradually,so,I can't complete the last step i.e. create the sheets according to 'Storage location' of MC.9 sheet.If you can complete the such macro,that will be a great help for me.Not in my job scenario also a well learning concept from you.

[HansV]

You'll have to try hard to learn - you cannot always depend on others for each change in your code.

Try this version:

Code: Select all

Sub CreateSheets()
    Dim wsh2 As Worksheet
    Dim wsh3 As Worksheet
    Dim r As Long
    Dim m As Long
    Dim t As Long
    Dim strName As String
    Application.ScreenUpdating = False
    ' Create MC.9 sheet
    Call CreateMC9
    Set wsh2 = Worksheets("MC.9")
    m = wsh2.Range("A1").End(xlDown).Row
    ' Location sheets
    For r = 2 To m + 1
        If wsh2.Range("C" & r).Value <> wsh2.Range("C" & (r - 1)).Value Then
            If t > 0 Then
                ' Format sheet
                With wsh3.Range("B5:G" & t)
                    .BorderAround _
                        LineStyle:=xlContinuous, _
                        ColorIndex:=0, _
                        Weight:=xlThin
                    With .Borders(xlInsideVertical)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With .Borders(xlInsideHorizontal)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                End With
                wsh3.Range("D6:D" & t).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
                wsh3.Range("E6:F" & t).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                wsh3.Range("G6:G" & t).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
                wsh3.Range("B6:F6").EntireColumn.AutoFit
                wsh3.Range("G6").ColumnWidth = 12.14 ' 90 pixels, at least on my computer
            End If
            If r > m Then Exit For
            strName = wsh2.Range("C" & r).Value
            ' Create sheet
            Set wsh3 = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            wsh3.Name = strName
            wsh3.Range("B4").Value = strName
            wsh3.Range("C4").Value = wsh2.Range("D" & r).Value
            wsh3.Range("B5").Value = "Material"
            wsh3.Range("C5").Value = "Material Description"
            wsh3.Range("D5").Value = "Book Qty"
            wsh3.Range("E5").Value = "Rate"
            wsh3.Range("F5").Value = "Amount"
            wsh3.Range("G5").Value = "Phy.Qty"
            wsh3.Range("B4:C4,B5:G5").Font.Bold = True
            wsh3.Range("B4:C4,B5:G5").HorizontalAlignment = xlCenter
            t = 5
        End If
        ' Copy data
        t = t + 1
        wsh3.Range("B" & t).Value = wsh2.Range("A" & r).Value
        wsh3.Range("C" & t).Value = wsh2.Range("B" & r).Value
        wsh3.Range("D" & t).Value = wsh2.Range("F" & r).Value
        wsh3.Range("F" & t).Value = wsh2.Range("G" & r).Value
        wsh3.Range("E" & t).FormulaR1C1 = "=RC[1]/RC[-1]"
    Next r
    Application.ScreenUpdating = True
End Sub

Sub CreateMC9()
    Dim wshD As Worksheet
    Dim wshM As Worksheet
    Dim wsh As Worksheet
    Dim r As Long
    Dim m As Long
    Dim t As Long
    Dim strMaterial As String
    Dim strLocation As String
    Dim p As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wshD = Worksheets("Dump")
    wshD.UsedRange.Sort Key1:=wshD.Range("B1"), Key2:=wshD.Range("A1"), Header:=xlYes
    For Each wsh In Worksheets
        If wsh.Name <> "Dump" Then
            wsh.Delete
        End If
    Next wsh
    Set wshM = Worksheets.Add(After:=wshD)
    wshM.Name = "MC.9"
    wshM.Cells(1, 1).Value = "Material"
    wshM.Cells(1, 2).Value = "Material Description"
    wshM.Cells(1, 3).Value = "Storage Location"
    wshM.Cells(1, 4).Value = "Description-Storage Location"
    wshM.Cells(1, 5).Value = "Unit"
    wshM.Cells(1, 6).Value = "Book Bal."
    wshM.Cells(1, 7).Value = "Amount"
    m = wshD.Cells(1, 1).End(xlDown).Row
    For r = m To 2 Step -1
        If wshD.Cells(r, 2).Value = "" Or wshD.Cells(r, 3).Value = 0 Then
            wshD.Cells(r, 1).EntireRow.Delete
        End If
    Next r
    t = 1
    m = wshD.Cells(1, 1).End(xlDown).Row
    For r = 2 To m
        t = t + 1
        strMaterial = wshD.Cells(r, 1).Value
        p = InStr(strMaterial, " ")
        wshM.Cells(t, 1).Value = Left(strMaterial, p - 1)
        wshM.Cells(t, 2).Value = Trim(Mid(strMaterial, p))
        strLocation = wshD.Cells(r, 2).Value
        p = InStr(strLocation, " ")
        wshM.Cells(t, 3).Value = Left(strLocation, p - 1)
        wshM.Cells(t, 4).Value = Trim(Mid(strLocation, p))
        wshM.Cells(t, 5).Value = wshD.Cells(r, 4).Value
        wshM.Cells(t, 6).Value = wshD.Cells(r, 3).Value
        wshM.Cells(t, 7).Value = wshD.Cells(r, 5).Value
    Next r
    wshM.Range("G2:G" & t).NumberFormat = "#,##0.00"
    With wshM.Range("A1:G1")
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
        .EntireColumn.AutoFit
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

[PRADEEPB270]

Hansv sir,
Many-2 thanks to you excel GOD.Now,the codes are working fine and I am very glad to learn from you.

I would like to share my heartiest views.

You are the great and I would like to say about you that you are one of the best excel expert in the world.