Consulting

Results 1 to 9 of 9

Thread: Help to modify VBA Code

  1. #1

    Help to modify VBA Code

    Hi All,

    I appreciate if anyone can help me. I have a VBA code in the "downloaded report". If I run it, the code will copy "pivot table look like" sheet and paste in the same workbook by creating a new sheet. This works great and have no issue.

    In addition, I also want to save this data in the last available row of another workbook called "Master Data" and add week # in the first column. The week # can be taken from the downloaded report.

    I have attached both workbook for reference. Please advice.

    Regards

    Sha

    downloaded report.xlsMaster Data.xls

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Sub test()
    Dim sh As Worksheet
    Dim shData As Worksheet
    Dim shMaster As Worksheet
    Dim data, result, production, igroup, article, vl
    Dim rowMasterLast As Long, rowsData As Long
    Dim lrow As Long, i As Long, j As Long, n As Long, k As Integer
    
        If IsError(Evaluate("'Downloaded report'!A1")) Then Exit Sub
        
        Set sh = Sheets("Downloaded report")
        With sh
        
            lrow = .UsedRange.Rows.Count
            If lrow < 10 Then Exit Sub
            
            data = .Range("b1:o" & lrow)
            
            ReDim result(1 To lrow, 1 To 14)
            
            result(1, 1) = data(2, 4)
            result(2, 1) = data(4, 5)
            result(3, 1) = "week#"
            result(4, 1) = "Date"
            result(3, 2) = data(8, 14)
            result(4, 2) = Format(data(9, 14), "[$-10407]dd-mm")
            
            For Each vl In Array(1, 6, 7, 9, 11, 12, 13)
            
                k = k + 1
                result(6, k) = data(9, vl)
            Next
            result(6, k + 1) = "Qty"
            
            j = 6
            For i = 10 To lrow
            
                If data(i, 1) <> "" Then production = data(i, 1)
                If data(i, 6) <> "" Then igroup = data(i, 6)
                If data(i, 7) <> "" Then
                
                    article = data(i, 7)
                    j = j + 1
                    result(j, 1) = production
                    result(j, 2) = igroup
                    result(j, 3) = article
                    k = 3
                    For Each vl In Array(9, 11, 12, 13, 14)
                    
                        k = k + 1
                        result(j, k) = data(i, vl)
                    Next
                End If
            Next
        End With
        
        Application.ScreenUpdating = False
        
        Set shMaster = Workbooks("Master Data.xls").Worksheets("Master Data")
        rowMasterLast = shMaster.Range("A1").End(xlDown).Row
            
        Set shData = Worksheets.Add
        With shData
        
            rowsData = j - 6
            
            .Range("a1:h" & j) = result
            
            .Range("a1,a3,a4,b4, a6:h6").Font.Bold = 1
            .Range("a3:b4").HorizontalAlignment = xlCenter
            .Range("a6:h" & j).Borders.LineStyle = xlContinuous
            .Range("a6:h" & j).Columns.AutoFit
            
            .Cells(7, "A").Resize(rowsData, 8).Copy shMaster.Cells(rowMasterLast + 1, "B")
            shMaster.Cells(rowMasterLast + 1, "A").Resize(rowsData).Value = .Range("B3").Value
            shMaster.Rows(rowMasterLast).Copy
            shMaster.Cells(rowMasterLast + 1, "A").Resize(rowsData).PasteSpecial Paste:=xlPasteFormats
        End With
        
        Application.CutCopyModemode = False
        Application.ScreenUpdating = True
    End Sub
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    beaten to it by xld!
    Master Data.xls should already be open.
    Sub test()
    Dim sh As Worksheet, NewSht As Worksheet, lrow As Long, data, result, i As Long, j As Long, production, igroup, article, n As Long, k As Integer, vl
    Dim DestnSht As Worksheet, DestnCell As Range
    
    If IsError(Evaluate("'Downloaded report'!A1")) Then Exit Sub
    Set sh = Sheets("Downloaded report")
    lrow = sh.UsedRange.Rows.Count
    If lrow < 10 Then Exit Sub
    
    data = sh.Range("b1:o" & lrow)
    ReDim result(1 To lrow, 1 To 14)
    
    result(1, 1) = data(2, 4)
    result(2, 1) = data(4, 5)
    result(3, 1) = "week#"
    result(4, 1) = "Date"
    result(3, 2) = data(8, 14)
    result(4, 2) = Format(data(9, 14), "[$-10407]dd-mm")
    
    For Each vl In Array(1, 6, 7, 9, 11, 12, 13)
      k = k + 1
      result(6, k) = data(9, vl)
    Next
    
    result(6, k + 1) = "Qty"
    j = 6
    For i = 10 To lrow
      If data(i, 1) <> "" Then production = data(i, 1)
      If data(i, 6) <> "" Then igroup = data(i, 6)
      If data(i, 7) <> "" Then
        article = data(i, 7)
        j = j + 1
        result(j, 1) = production
        result(j, 2) = igroup
        result(j, 3) = article
        k = 3
        For Each vl In Array(9, 11, 12, 13, 14)
          k = k + 1
          result(j, k) = data(i, vl)
        Next
      End If
    Next
    
    Application.ScreenUpdating = 0
    
    Set NewSht = Sheets.Add
    With NewSht
      .Range("a1:h" & j) = result
      .Range("a1,a3,a4,b4, a6:h6").Font.Bold = 1
      .Range("a3:b4").HorizontalAlignment = xlCenter
      .Range("a6:h" & j).Borders.LineStyle = xlContinuous
      .Range("a6:h" & j).Columns.AutoFit
      Set DestnSht = Workbooks("Master Data.xls").Sheets("Master Data")
      With DestnSht
        Set DestnCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
      End With
      .Range("a7:h" & j).Copy DestnCell.Offset(, 1)
      With DestnCell.Resize(j - 6)
        .Value = data(8, 14)
        .Borders.LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
      End With
    End With
    Application.ScreenUpdating = 1
    End Sub
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  4. #4
    WoW.. That's work great.

    Just a small changes in the code for added functionality.

    Can I put this Code into a Different file and When I run the code, it ask me to pick the source file "downloaded report" to copy data from.

    Once it select the source file, rather then creating Worksheet in the "downloaded report", it let me pick First excel file and save in tab "abc". Once its done, it then let me pick second Excel file "master Data" and save in the last available row.

    Hope I am not asking too much changes in the above code.

    Regards

    Sha

  5. #5
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Who are you directing that at, me or p45cal?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  6. #6
    Well I tried both and both code works

    anyone can help me if it's okay?

  7. #7
    Well Thank you both of you

    Second Part i have sorted out myself.

    Thank you once again.

    Regards

    Sha

  8. #8
    Well Thank you both of you

    Second Part i have sorted out myself.

    Thank you once again. but how i can acknowledge your effort ?

    Regards

    Sha

  9. #9
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    Quote Originally Posted by shido View Post
    but how i can acknowledge your effort ?
    You already have, just by replying

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •