Results 1 to 3 of 3
Like Tree1Likes
  • 1 Post By James006

VBA - need a little help to change output destination for existing macro

This is a discussion on VBA - need a little help to change output destination for existing macro within the Excel Questions forums, part of the Question Forums category; Hello. I'm not really familiar with VBA code and I'll appreciate some help here. I'm using this macro to SUM ...

  1. #1
    Board Regular smide's Avatar
    Join Date
    Dec 2015
    Posts
    106

    Default VBA - need a little help to change output destination for existing macro

    Hello.


    I'm not really familiar with VBA code and I'll appreciate some help here.


    I'm using this macro to SUM previous six values for my Product's (text cells) in columns A and B (A2:A600 and B2:B600).
    So Products are in columns A and B and their values are in columns C and D.


    When Product is in column A his value is in the same row in column C, and when Product is in column B his value is in the same row but now in column D.


    Finally, after this 'original' macro run outputs/results (SUM of previous six values for each Product) are placed in columns E and F (the same row where referent Product appears).

    Macro:

    Code:
    Sub sum()
    On Error Resume Next
    Dim Rng As Range, Dn As Range, n As Long, K As Variant, R As Range, c As Long, Tot As Long
    Dim temp As Long, V As Range, fD As Boolean
    Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)).Resize(, 2)
    With CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    For Each Dn In Rng
        If Not .Exists(Dn.Value) Then
            .Add Dn.Value, Dn
        Else
            Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
    End If
    Next
    Dim t
    For Each K In .keys
        For Each V In .Item(K)
            c = 0: Tot = 0: temp = 0
            For Each R In .Item(K)
                If R.Address = V.Address Then fD = True
                    If fD Then
                        If c = 0 And temp <> 0 Then
                            R.Offset(, 4).Value = temp: temp = 0
                            fD = False: Exit For
                        End If
                            c = c + 1
                            Tot = Tot + R.Offset(, 2).Value
                        
                        If c = 6 Then
                            temp = Tot
                            c = 0: Tot = 0
                        End If
                    End If
            Next R
        Next V
    Next K
    End With
    End Sub
    I would like to do the following changes in this 'original' macro:


    - Instead of columns A and B I want to change search area for my Product's list in columns C and D
    - Instead of columns C and D where my current values for Products are I want to change search area for them (values) in columns S and T
    - Results are placed now in columns E and F but I want to change this also and to place results in columns BL and BM


    I'll really appreciate some short explanation about changes done in code (if possible) so that I could adjust code next time if necessary.
    Last edited by smide; Jul 17th, 2017 at 07:40 AM.

  2. #2
    Board Regular
    Join Date
    Apr 2009
    Posts
    1,578

    Default Re: VBA - need a little help to change output destination for existing macro

    Hello,

    There are only a few tiny modifications required to be in line with your new worksheet structure ...
    Code:
    Sub NewSumPrevious6()
    
    
    ' Sum Previous 6 Values
    
    
    On Error Resume Next
    
    
    Dim Rng As Range, Dn As Range, n As Long, K As Variant, R As Range, c As Long, Tot As Long
    Dim temp As Long, V As Range, fD As Boolean
    
    
    Set Rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp)).Resize(, 2)
    With CreateObject("scripting.dictionary")
      .CompareMode = vbTextCompare
        For Each Dn In Rng
            If Not .Exists(Dn.Value) Then
                .Add Dn.Value, Dn
            Else
                Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
            End If
        Next Dn
        
        For Each K In .keys
            For Each V In .Item(K)
                c = 0: Tot = 0: temp = 0
                For Each R In .Item(K)
                    If R.Address = V.Address Then fD = True
                        If fD Then
                            If c = 0 And temp <> 0 Then
                                R.Offset(, 61).Value = temp: temp = 0
                                fD = False: Exit For
                            End If
                                c = c + 1
                                Tot = Tot + R.Offset(, 16).Value
                            If c = 6 Then
                                temp = Tot
                                c = 0: Tot = 0
                            End If
                        End If
                Next R
            Next V
        Next K
    End With
    End Sub
    Hope this will help
    smide likes this.

  3. #3
    Board Regular smide's Avatar
    Join Date
    Dec 2015
    Posts
    106

    Default Re: VBA - need a little help to change output destination for existing macro

    Quote Originally Posted by James006 View Post
    Hello,

    There are only a few tiny modifications required to be in line with your new worksheet structure ...
    Code:
    Sub NewSumPrevious6()
    
    
    ' Sum Previous 6 Values
    
    
    On Error Resume Next
    
    
    Dim Rng As Range, Dn As Range, n As Long, K As Variant, R As Range, c As Long, Tot As Long
    Dim temp As Long, V As Range, fD As Boolean
    
    
    Set Rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp)).Resize(, 2)
    With CreateObject("scripting.dictionary")
      .CompareMode = vbTextCompare
        For Each Dn In Rng
            If Not .Exists(Dn.Value) Then
                .Add Dn.Value, Dn
            Else
                Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
            End If
        Next Dn
        
        For Each K In .keys
            For Each V In .Item(K)
                c = 0: Tot = 0: temp = 0
                For Each R In .Item(K)
                    If R.Address = V.Address Then fD = True
                        If fD Then
                            If c = 0 And temp <> 0 Then
                                R.Offset(, 61).Value = temp: temp = 0
                                fD = False: Exit For
                            End If
                                c = c + 1
                                Tot = Tot + R.Offset(, 16).Value
                            If c = 6 Then
                                temp = Tot
                                c = 0: Tot = 0
                            End If
                        End If
                Next R
            Next V
        Next K
    End With
    End Sub
    Hope this will help
    Yes I got it, changing columns number in offset function.


    Currently this macro SUM previous six values following this rules:
    - when Product is in column C his value is in the same row in column S
    - when Product is in column D his value is in the same row but now in column T


    Suppose I need to SUM also previous six values but this time values from opposite columns eg. :
    - when Product is in column C his value is in the same row but now in column T
    - when Product is in column D his value is in the same row but now in column S


    Do you have any idea how to modify existing macro according to these new requirements?

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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


DMCA.com